;;;; syntax.test --- test suite for Guile's syntactic forms -*- scheme -*-
;;;;
;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2009, 2010,
-;;;; 2011, 2012, 2013 Free Software Foundation, Inc.
+;;;; 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
(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")
(pass-if-syntax-error "(define)"
exception:generic-syncase-error
(eval '(define)
- (interaction-environment)))))
+ (interaction-environment))))
+
+ (pass-if "module scoping"
+ (equal?
+ (eval
+ '(begin
+ (define-module (top-level-define/module-scoping-1)
+ #:export (define-10))
+ (define-syntax-rule (define-10 name)
+ (begin
+ (define t 10)
+ (define (name) t)))
+ (define-module (top-level-define/module-scoping-2)
+ #:use-module (top-level-define/module-scoping-1))
+ (define-10 foo)
+ (foo))
+ (current-module))
+ 10))
+
+ (pass-if "module scoping, same symbolic name"
+ (equal?
+ (eval
+ '(begin
+ (define-module (top-level-define/module-scoping-3))
+ (define a 10)
+ (define-module (top-level-define/module-scoping-4)
+ #:use-module (top-level-define/module-scoping-3))
+ (define a (@@ (top-level-define/module-scoping-3) a))
+ a)
+ (current-module))
+ 10))
+
+ (pass-if "module scoping, introduced names"
+ (equal?
+ (eval
+ '(begin
+ (define-module (top-level-define/module-scoping-5)
+ #:export (define-constant))
+ (define-syntax-rule (define-constant name val)
+ (begin
+ (define t val)
+ (define (name) t)))
+ (define-module (top-level-define/module-scoping-6)
+ #:use-module (top-level-define/module-scoping-5))
+ (define-constant foo 10)
+ (define-constant bar 20)
+ (foo))
+ (current-module))
+ 10))
+
+ (pass-if "module scoping, duplicate introduced name"
+ (equal?
+ (eval
+ '(begin
+ (define-module (top-level-define/module-scoping-7)
+ #:export (define-constant))
+ (define-syntax-rule (define-constant name val)
+ (begin
+ (define t val)
+ (define (name) t)))
+ (define-module (top-level-define/module-scoping-8)
+ #:use-module (top-level-define/module-scoping-7))
+ (define-constant foo 10)
+ (define-constant foo 20)
+ (foo))
+ (current-module))
+ 20)))
(with-test-prefix "internal define"
(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"
'((((x y) …) ...)
(((x y) ...) …)))))))
(define-syntax bar (foo x y z))
- (bar a b c))))
+ (bar a b c)))
+
+ ;; This test is given in SRFI-46.
+ (pass-if-equal "custom ellipsis is handled hygienically"
+ '((1) 2 (3) (4))
+ (let-syntax
+ ((f (syntax-rules ()
+ ((f ?e)
+ (let-syntax
+ ((g (syntax-rules --- ()
+ ((g (??x ?e) (??y ---))
+ '((??x) ?e (??y) ---)))))
+ (g (1 2) (3 4)))))))
+ (f ---))))
(with-test-prefix "syntax-error"
HCoop / bpt / guile.git / blobdiff