syntax.test is passing, yay

* test-suite/tests/syntax.test ("top-level define"): Remove the test for
  currying, as we don't do that any more by default. It should be easy
  for the user to add in if she wants it, though.
  ("do"): Remove unmemoization tests, as sc-expand fully expands `do'.
  ("while"): Remove while tests in empty environments. They have been
  throwing 'unresolved, and the problem they seek to test is fully
  handled by hygiene anyway.

  And otherwise tweak expected exception strings, and everything passes!

diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 15f8602..aa2e051 100644 (file)
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -34,7 +34,7 @@
 (define exception:missing-expr
   (cons 'syntax-error "Missing expression"))
 (define exception:missing-body-expr
-  (cons 'syntax-error "Missing body expression"))
+  (cons 'syntax-error "no expressions in body"))
 (define exception:extra-expr
   (cons 'syntax-error "Extra expression"))
 (define exception:illegal-empty-combination
@@ -46,6 +46,10 @@
   '(syntax-error . "bad let "))
 (define exception:bad-letrec
   '(syntax-error . "bad letrec "))
+(define exception:bad-set!
+  '(syntax-error . "bad set!"))
+(define exception:bad-quote
+  '(syntax-error . "quote: bad syntax"))
 (define exception:bad-bindings
   (cons 'syntax-error "Bad bindings"))
 (define exception:bad-binding
@@ -801,14 +805,6 @@
       (eval '(define round round) m)
       (eq? (module-ref m 'round) round)))
 
-  (with-test-prefix "currying"
-
-    (pass-if "(define ((foo)) #f)"
-      (eval '(begin
-               (define ((foo)) #t)
-               ((foo)))
-            (interaction-environment))))
-
   (with-test-prefix "unmemoization"
 
     (pass-if "definition unmemoized without prior execution"
@@ -830,7 +826,7 @@
   (with-test-prefix "missing or extra expressions"
 
     (pass-if-exception "(define)"
-      exception:missing-expr
+      exception:generic-syncase-error
       (eval '(define)
            (interaction-environment)))))
 
@@ -907,34 +903,10 @@
                  'ok)
                (bar))
              (foo)
-             (equal?
+             (matches?
               (procedure-source foo)
-              '(lambda () (letrec ((bar (lambda () (quote ok)))) (bar)))))
-          (interaction-environment))))
-
-(with-test-prefix "do"
-
-  (with-test-prefix "unmemoization"
-
-    (pass-if "normal case"
-      (let ((foo (lambda () (do ((i 1 (+ i 1)) (j 2))
-                                ((> i 9) (+ i j))
-                              (identity i)))))
-        (foo) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (do ((i 1 (+ i 1)) (j 2))
-                                ((> i 9) (+ i j))
-                              (identity i))))))
-
-    (pass-if "reduced case"
-      (let ((foo (lambda () (do ((i 1 (+ i 1)) (j 2 j)) ; redundant step for j
-                                ((> i 9) (+ i j))
-                              (identity i)))))
-        (foo) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda () (do ((i 1 (+ i 1)) (j 2)) ; no redundancy here
-                                ((> i 9) (+ i j))
-                              (identity i))))))))
+              (lambda () (letrec ((_ (lambda () (quote ok)))) (_)))))
+          (current-module))))
 
 (with-test-prefix "set!"
 
@@ -943,50 +915,50 @@
     (pass-if "normal set!"
       (let ((foo (lambda (x) (set! x (+ 1 x)))))
         (foo 1) ; make sure, memoization has been performed
-        (equal? (procedure-source foo)
-                '(lambda (x) (set! x (+ 1 x)))))))
+        (matches? (procedure-source foo)
+                  (lambda (_) (set! _ (+ 1 _)))))))
 
   (with-test-prefix "missing or extra expressions"
 
     (pass-if-exception "(set!)"
-      exception:missing/extra-expr
+      exception:bad-set!
       (eval '(set!)
            (interaction-environment)))
 
     (pass-if-exception "(set! 1)"
-      exception:missing/extra-expr
+      exception:bad-set!
       (eval '(set! 1)
            (interaction-environment)))
 
     (pass-if-exception "(set! 1 2 3)"
-      exception:missing/extra-expr
+      exception:bad-set!
       (eval '(set! 1 2 3)
            (interaction-environment))))
 
   (with-test-prefix "bad variable"
 
     (pass-if-exception "(set! \"\" #t)"
-      exception:bad-variable
+      exception:bad-set!
       (eval '(set! "" #t)
            (interaction-environment)))
 
     (pass-if-exception "(set! 1 #t)"
-      exception:bad-variable
+      exception:bad-set!
       (eval '(set! 1 #t)
            (interaction-environment)))
 
     (pass-if-exception "(set! #t #f)"
-      exception:bad-variable
+      exception:bad-set!
       (eval '(set! #t #f)
            (interaction-environment)))
 
     (pass-if-exception "(set! #f #t)"
-      exception:bad-variable
+      exception:bad-set!
       (eval '(set! #f #t)
            (interaction-environment)))
 
     (pass-if-exception "(set! #\\space #f)"
-      exception:bad-variable
+      exception:bad-set!
       (eval '(set! #\space #f)
            (interaction-environment)))))
 
@@ -995,12 +967,12 @@
   (with-test-prefix "missing or extra expression"
 
     (pass-if-exception "(quote)"
-      exception:missing/extra-expr
+      exception:bad-quote
       (eval '(quote)
            (interaction-environment)))
 
     (pass-if-exception "(quote a b)"
-      exception:missing/extra-expr
+      exception:bad-quote
       (eval '(quote a b)
            (interaction-environment)))))
 
@@ -1052,37 +1024,6 @@
       (unreachable))
     #t)
   
-  (with-test-prefix "in empty environment"
-
-    ;; an environment with no bindings at all
-    (define empty-environment
-      (make-module 1))
-
-    ;; these tests are 'unresolved because to work with ice-9 syncase it was
-    ;; necessary to drop the unquote from `do' in the implementation, and
-    ;; unfortunately that makes `while' depend on its evaluation environment
-      
-    (pass-if "empty body"
-      (throw 'unresolved)
-      (eval `(,while #f)
-           empty-environment)
-      #t)
-    
-    (pass-if "initially false"
-      (throw 'unresolved)
-      (eval `(,while #f
-              #f)
-           empty-environment)
-      #t)
-    
-    (pass-if "iterating"
-      (throw 'unresolved)
-      (let ((cond (make-iterations-cond 3)))
-       (eval `(,while (,cond)
-                123 456)
-             empty-environment))
-      #t))
-  
   (with-test-prefix "iterations"
     (do ((n 0 (1+ n)))
        ((> n 5))
@@ -1096,8 +1037,9 @@
   (with-test-prefix "break"
     
     (pass-if-exception "too many args" exception:wrong-num-args
-      (while #t
-       (break 1)))
+      (eval '(while #t
+               (break 1))
+            (interaction-environment)))
     
     (with-test-prefix "from cond"
       (pass-if "first"
@@ -1168,8 +1110,9 @@
   (with-test-prefix "continue"
     
     (pass-if-exception "too many args" exception:wrong-num-args
-      (while #t
-       (continue 1)))
+      (eval '(while #t
+               (continue 1))
+            (interaction-environment)))
     
     (with-test-prefix "from cond"
       (do ((n 0 (1+ n)))