diff options
-rw-r--r-- | test-suite/tests/syntax.test | 111 |
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))) |