(define exception:too-many-args
"too many arguments")
+(define exception:wrong-number-of-values
+ '(wrong-number-of-args . "number of (values)|(arguments)"))
(define exception:zero-expression-sequence
"sequence of zero expressions")
+(define exception:variable-ref
+ '(misc-error . "Unbound variable"))
;; (put 'pass-if-syntax-error 'scheme-indent-function 1)
(define-syntax pass-if-syntax-error
(with-test-prefix "bindings"
- (pass-if-syntax-error "initial bindings are undefined"
- exception:used-before-defined
- (let ((x 1))
- ;; FIXME: the memoizer does initialize the var to undefined, but
- ;; the Scheme evaluator has no way of checking what's an
- ;; undefined value. Not sure how to do this.
- (throw 'unresolved)
- (letrec ((x 1) (y x)) y))))
+ (pass-if-exception "initial bindings are undefined"
+ exception:variable-ref
+ (eval '(let ((x 1))
+ (letrec ((x 1) (y x)) y))
+ (interaction-environment))))
(with-test-prefix "bad bindings"
(with-test-prefix "bindings"
- (pass-if-syntax-error "initial bindings are undefined"
- exception:used-before-defined
- (begin
- ;; FIXME: the memoizer does initialize the var to undefined, but
- ;; the Scheme evaluator has no way of checking what's an
- ;; undefined value. Not sure how to do this.
- (throw 'unresolved)
- (letrec* ((x y) (y 1)) y))))
+ (pass-if-exception "initial bindings are undefined"
+ exception:variable-ref
+ (eval '(letrec* ((x y) (y 1)) y)
+ (interaction-environment))))
(with-test-prefix "bad bindings"
(interaction-environment))))
(with-test-prefix "referencing previous values"
- (pass-if (equal? (letrec ((a (cons 'foo 'bar))
- (b a))
+ (pass-if (equal? (letrec* ((a (cons 'foo 'bar))
+ (b a))
b)
'(foo . bar)))
(pass-if (equal? (let ()
(eval '(let () (define x #t))
(interaction-environment))))
+(with-test-prefix "top-level define-values"
+
+ (pass-if "zero values"
+ (eval '(begin (define-values () (values))
+ #t)
+ (interaction-environment)))
+
+ (pass-if-equal "one value"
+ 1
+ (eval '(begin (define-values (x) 1)
+ x)
+ (interaction-environment)))
+
+ (pass-if-equal "two values"
+ '(2 3)
+ (eval '(begin (define-values (x y) (values 2 3))
+ (list x y))
+ (interaction-environment)))
+
+ (pass-if-equal "three values"
+ '(4 5 6)
+ (eval '(begin (define-values (x y z) (values 4 5 6))
+ (list x y z))
+ (interaction-environment)))
+
+ (pass-if-equal "one value with tail"
+ '(a (b c d))
+ (eval '(begin (define-values (x . y) (values 'a 'b 'c 'd))
+ (list x y))
+ (interaction-environment)))
+
+ (pass-if-equal "two values with tail"
+ '(x y (z w))
+ (eval '(begin (define-values (x y . z) (values 'x 'y 'z 'w))
+ (list x y z))
+ (interaction-environment)))
+
+ (pass-if-equal "just tail"
+ '(1 2 3)
+ (eval '(begin (define-values x (values 1 2 3))
+ x)
+ (interaction-environment)))
+
+ (pass-if-exception "expected 0 values, got 1"
+ exception:wrong-number-of-values
+ (eval '(define-values () 1)
+ (interaction-environment)))
+
+ (pass-if-exception "expected 1 value, got 0"
+ exception:wrong-number-of-values
+ (eval '(define-values (x) (values))
+ (interaction-environment)))
+
+ (pass-if-exception "expected 1 value, got 2"
+ exception:wrong-number-of-values
+ (eval '(define-values (x) (values 1 2))
+ (interaction-environment)))
+
+ (pass-if-exception "expected 1 value with tail, got 0"
+ exception:wrong-number-of-values
+ (eval '(define-values (x . y) (values))
+ (interaction-environment)))
+
+ (pass-if-exception "expected 2 value with tail, got 1"
+ exception:wrong-number-of-values
+ (eval '(define-values (x y . z) 1)
+ (interaction-environment)))
+
+ (pass-if "redefinition"
+ (let ((m (make-module)))
+ (beautify-user-module! m)
+
+ ;; The previous values of `floor' and `round' must still be
+ ;; visible at the time the new `floor' and `round' are defined.
+ (eval '(define-values (floor round) (values floor round)) m)
+ (and (eq? (module-ref m 'floor) floor)
+ (eq? (module-ref m 'round) round))))
+
+ (with-test-prefix "missing expression"
+
+ (pass-if-syntax-error "(define-values)"
+ exception:generic-syncase-error
+ (eval '(define-values)
+ (interaction-environment)))))
+
+(with-test-prefix "internal define-values"
+
+ (pass-if "zero values"
+ (let ()
+ (define-values () (values))
+ #t))
+
+ (pass-if-equal "one value"
+ 1
+ (let ()
+ (define-values (x) 1)
+ x))
+
+ (pass-if-equal "two values"
+ '(2 3)
+ (let ()
+ (define-values (x y) (values 2 3))
+ (list x y)))
+
+ (pass-if-equal "three values"
+ '(4 5 6)
+ (let ()
+ (define-values (x y z) (values 4 5 6))
+ (list x y z)))
+
+ (pass-if-equal "one value with tail"
+ '(a (b c d))
+ (let ()
+ (define-values (x . y) (values 'a 'b 'c 'd))
+ (list x y)))
+
+ (pass-if-equal "two values with tail"
+ '(x y (z w))
+ (let ()
+ (define-values (x y . z) (values 'x 'y 'z 'w))
+ (list x y z)))
+
+ (pass-if-equal "just tail"
+ '(1 2 3)
+ (let ()
+ (define-values x (values 1 2 3))
+ x))
+
+ (pass-if-exception "expected 0 values, got 1"
+ exception:wrong-number-of-values
+ (eval '(let ()
+ (define-values () 1)
+ #f)
+ (interaction-environment)))
+
+ (pass-if-exception "expected 1 value, got 0"
+ exception:wrong-number-of-values
+ (eval '(let ()
+ (define-values (x) (values))
+ #f)
+ (interaction-environment)))
+
+ (pass-if-exception "expected 1 value, got 2"
+ exception:wrong-number-of-values
+ (eval '(let ()
+ (define-values (x) (values 1 2))
+ #f)
+ (interaction-environment)))
+
+ (pass-if-exception "expected 1 value with tail, got 0"
+ exception:wrong-number-of-values
+ (eval '(let ()
+ (define-values (x . y) (values))
+ #f)
+ (interaction-environment)))
+
+ (pass-if-exception "expected 2 value with tail, got 1"
+ exception:wrong-number-of-values
+ (eval '(let ()
+ (define-values (x y . z) 1)
+ #f)
+ (interaction-environment)))
+
+ (with-test-prefix "missing expression"
+
+ (pass-if-syntax-error "(define-values)"
+ exception:generic-syncase-error
+ (eval '(let ()
+ (define-values)
+ #f)
+ (interaction-environment)))))
+
(with-test-prefix "set!"
(with-test-prefix "missing or extra expressions"
HCoop / bpt / guile.git / blobdiff