(module section-3-natural-embedding-1-tests mzscheme
  
  (require "section-3-natural-embedding-1.ss"
           "language-test-tools.ss")
  (provide tests)
  
  (define-tester test E)

  (define tests
    (test-suite "simple natural embedding"
      (test-suite "basic operation"
        (test ((lambda (x : num) x) 4) 4)
        (test ((lambda (x : (num -> num)) x) (lambda (y : num) y))
              (lambda (y : num) y))
        (test (+ 5 12) 17)
        (test (- 12 5) 7)
        (test (- 5 12) 0)
        (test (ifzero 0 2 3) 2)
        (test (ifzero 1 2 3) 3))
      (test-suite "basic embedded program evaluation"
        (test (MSG num (nat? 12)) 0)
        (test (MSG num (proc? 12)) 1)
        (test (MSG num (proc? (lambda (x) x))) 0)
        (test (MSG num (proc? 32)) 1)
        (test (MSG num (ifzero (wrong "user-level error") 2 3)) "user-level error")
        (test (MSG num (ifzero 0 (wrong "user-level error") 2)) "user-level error")
        (test (MSG num (ifzero 1 (wrong "user-level error") 2)) 2))
      (test-suite "type tests"
        (test ((lambda (x : num) x) 4) 4)
        (test ((lambda (x : (num -> num)) x) 4) "Type error")
        (test ((lambda (x : num) x) (lambda (y : num) y)) "Type error")
        (test ((lambda (x : ((num -> num) -> (num -> num))) x) (lambda (y : (num -> num)) y))
              (lambda (y : num) y))
        (test (MSG num ((lambda (x) x) 4)) 4)
        (test (((lambda (x : (num -> num)) (lambda (y : (num -> num)) y)) (lambda (x : num) x)) 
               (MSG (num -> num) (lambda (z) (z z))))
              (lambda (y : num) (MSG num ((lambda (z) (z z)) (GSM num y)))))
        (test (MSG num (GSM num ((lambda (x : (num -> num)) (x 5)) (MSG (num -> num) 5)))) "Non-procedure")
        (test (MSG num ((GSM (num -> num) (lambda (x : num) x)) (lambda (y) y))) "Non-number")
        (test (MSG num (GSM num 1)) 1)
        (test (MSG (num -> num) (GSM num 1)) "Non-procedure")
        (test (MSG num (GSM (num -> num) 1)) "Type error")
        (test (MSG num (lambda (x) (GSM num 1))) "Non-number")
        (test (MSG (num -> num) (GSM (num -> num) (lambda (x : num) x)))
              (lambda (y : num)
                (MSG num ((lambda (z) (GSM num ((lambda (x : num) x) (MSG num z))))
                          (GSM num y)))))
        (test ((MSG (num -> num) (GSM (num -> num) (lambda (x : num) x))) 1) 1)
        (test (MSG (num -> num) ((GSM (num -> num) (lambda (x : num) x)) (lambda (x) x))) "Non-number")
        (test (MSG num ((GSM (num -> num) ((MSG (num -> (num -> num)) (lambda (x) x)) 5)) 1)) "Non-procedure")))))