summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--test-suite/tests/syntax.test111
1 files changed, 27 insertions, 84 deletions
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 15f8602cf..aa2e05127 100644
--- 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)))