mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

syntax.test is passing, yay

Browse source 
* 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!
This commit is contained in:
Andy Wingo 2009-05-22 12:22:39 +02:00
parent dc1eed52f7
commit 9ecac781bf
1 changed files with 27 additions and 84 deletions
Download patch file Download diff file Expand all files Collapse all files

111
test-suite/tests/syntax.test
View file

@ -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)))