(module tests mzscheme (provide test-list) ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;; (define test-list '( ;; simple arithmetic (positive-const "11" 11) (negative-const "-33" -33) (simple-arith-1 "-(44,33)" 11) ;; nested arithmetic (nested-arith-left "-(-(44,33),22)" -11) (nested-arith-right "-(55, -(22,11))" 44) ;; simple variables (test-var-1 "x" 10) (test-var-2 "-(x,1)" 9) (test-var-3 "-(1,x)" -9) ;; simple unbound variables (test-unbound-var-1 "foo" error) (test-unbound-var-2 "-(x,foo)" error) ;; simple conditionals (if-true "if =(0,0) then 3 else 4" 3) (if-false "if =(0,1) then 3 else 4" 4) ;; test dynamic typechecking (no-bool-to-diff-1 "-(=(0,0),1)" error) (no-bool-to-diff-2 "-(1,=(0,0))" error) (no-int-to-if "if 1 then 2 else 3" error) ;; make sure that the test and both arms get evaluated ;; properly. (if-eval-test-true "if =(0,-(11,11)) then 3 else 4" 3) (if-eval-test-false "if =(0,-(11, 12)) then 3 else 4" 4) ;; and make sure the other arm doesn't get evaluated. (if-eval-test-true-2 "if =(0,-(11, 11)) then 3 else foo" 3) (if-eval-test-false-2 "if =(0,-(11,12)) then foo else 4" 4) ;; translation of simple let (simple-let-1 "define f = proc (x) x (f 3)" 3) ;; make sure the bodies and operands get evaluated (eval-proc-body-1 "define f = proc (x) -(x,1) (f 3)" 2) (eval-proc-body-2 "define f = proc (x) -(x,1) (f -(4,1))" 2) ;; check shadowing (eval-proc-body-2 "define x = proc (x) -(x,1) (x -(4,1))" 2) ;; zero arguments (zero-arguments "define f = proc () 13 define g = proc () 14 *((f),(g))" 182) ;; two or more arguments (two-arguments "define f = proc (x y) *(x,y) define g = proc (a b) +(a,b) (f (g 3 10) (g 7 7))" 182) (fact-of-6 "define fact = proc (x) if =(0,x) then 1 else *(x, (fact -(x,1))) (fact 6)" 720) (mutual-recursion "define even = proc (n) if =(0,n) then true else (odd -(n,1)) define odd = proc (n) if =(0,n) then false else (even -(n,1)) (odd 13)" #t) (higher-order "define search = proc (x f i j) if >(i,j) then -1 else if =(x,(f i)) then i else (search x f +(i,1) j) define g = proc (square x a b c) +(*(a,(square x)),+(*(b,x),c)) define square = proc (x) *(x,x) define h = proc (x) (g square x 5 -13 7) (search 1231 h 0 25)" 17) (prime "define prime = proc (i) if <(i,2) then +(i,2) else (primesearch +(2,(prime -(i,1)))) define primesearch = proc (n) if (primetest n) then n else (primesearch +(n,2)) define primetest = proc (n) if (divides 2 n) then false else (primetests 3 n) define primetests = proc (d n) if >(*(d,d),n) then true else if (divides d n) then false else (primetests +(d,2) n) define divides = proc (d n) (dividesloop 1 d n) define dividesloop = proc (q d n) if =(*(q,d),n) then true else if >(*(q,d),n) then false else (dividesloop +(q,1) d n) (prime 30)" 127) (choose-11 "choose (11,11)" 11) (choose-well-1 "define loop = proc (n) if =(n,0) then 55 else (loop +(n,1)) choose ((loop -1), (loop 1))" 55) (choose-well-2 "define loop = proc (n) if =(n,0) then 55 else (loop +(n,1)) choose ((loop 1), (loop -1))" 55) (choose-prime "define primesearch = proc (n) choose (if (primetest n) then n else fail, (primesearch +(n,1))) define primetest = proc (n) if (divides 2 n) then false else (primetests 3 n) define primetests = proc (d n) if >(*(d,d),n) then true else if (divides d n) then false else (primetests +(d,2) n) define divides = proc (d n) (dividesloop 1 d n) define dividesloop = proc (q d n) if =(*(q,d),n) then true else if >(*(q,d),n) then false else (dividesloop +(q,1) d n) (primesearch 8)" 11) (choose-a-different-prime "define primesearch = proc (n) choose (if (primetest n) then n else fail, (primesearch +(n,1))) define primetest = proc (n) if (divides 2 n) then false else (primetests 3 n) define primetests = proc (d n) if >(*(d,d),n) then true else if (divides d n) then false else (primetests +(d,2) n) define divides = proc (d n) (dividesloop 1 d n) define dividesloop = proc (q d n) if =(*(q,d),n) then true else if >(*(q,d),n) then false else (dividesloop +(q,1) d n) define different = proc (n except) (different2 n except (primesearch n)) define different2 = proc (n except candidate) if =(except, candidate) then fail else candidate (different 8 11)" 13) (choose-a-different-prime/cut "define primesearch = proc (n) choose/cut (if (primetest n) then n else fail, (primesearch +(n,1))) define primetest = proc (n) if (divides 2 n) then false else (primetests 3 n) define primetests = proc (d n) if >(*(d,d),n) then true else if (divides d n) then false else (primetests +(d,2) n) define divides = proc (d n) (dividesloop 1 d n) define dividesloop = proc (q d n) if =(*(q,d),n) then true else if >(*(q,d),n) then false else (dividesloop +(q,1) d n) define different = proc (n except) (different2 n except (primesearch n)) define different2 = proc (n except candidate) if =(except, candidate) then fail else candidate (different 8 11)" error) )) )