1 ;;;; optargs.test --- test suite for optional arg processing -*- scheme -*-
2 ;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
4 ;;;; Copyright (C) 2001, 2006, 2009, 2010 Free Software Foundation, Inc.
6 ;;;; This library is free software; you can redistribute it and/or
7 ;;;; modify it under the terms of the GNU Lesser General Public
8 ;;;; License as published by the Free Software Foundation; either
9 ;;;; version 3 of the License, or (at your option) any later version.
11 ;;;; This library is distributed in the hope that it will be useful,
12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;;;; Lesser General Public License for more details.
16 ;;;; You should have received a copy of the GNU Lesser General Public
17 ;;;; License along with this library; if not, write to the Free Software
18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20 (define-module (test-suite test-optargs)
21 #:use-module (test-suite lib)
22 #:use-module (system base compile)
23 #:use-module (ice-9 optargs))
25 (define exception:unrecognized-keyword
26 '(keyword-argument-error . "Unrecognized keyword"))
28 (define exception:extraneous-arguments
29 ;; Message depends on whether we use the interpreter or VM, and on the
30 ;; evenness of the number of extra arguments (!).
31 ;'(keyword-argument-error . ".*")
35 (syntax-rules (pass-if pass-if-exception)
36 ((_ (pass-if test-name exp))
37 (begin (pass-if (string-append test-name " (eval)")
38 (primitive-eval 'exp))
39 (pass-if (string-append test-name " (compile)")
40 (compile 'exp #:to 'value #:env (current-module)))))
41 ((_ (pass-if-exception test-name exc exp))
42 (begin (pass-if-exception (string-append test-name " (eval)")
43 exc (primitive-eval 'exp))
44 (pass-if-exception (string-append test-name " (compile)")
45 exc (compile 'exp #:to 'value
46 #:env (current-module)))))))
48 (define-syntax with-test-prefix/c&e
50 ((_ section-name exp ...)
51 (with-test-prefix section-name (c&e exp) ...))))
53 (with-test-prefix/c&e "optional argument processing"
54 (pass-if "local defines work with optional arguments"
56 (define* (test-1 #:optional (x 0))
57 (define d 1) ; local define
59 (false-if-exception (test-1)))
60 (interaction-environment))))
66 (with-test-prefix/c&e "let-keywords"
68 ;; in guile 1.6.4 and earlier, an empty binding list only used `begin',
69 ;; which caused apparently internal defines to "leak" out into the
70 ;; encompasing environment
71 (pass-if-exception "empty bindings internal defines leaking out"
74 (let-keywords rest #f ()
80 (let-keywords '(#:foo 123) #f (foo)
87 (with-test-prefix/c&e "let-keywords*"
89 ;; in guile 1.6.4 and earlier, an empty binding list only used `begin',
90 ;; which caused apparently internal defines to "leak" out into the
91 ;; encompasing environment
92 (pass-if-exception "empty bindings internal defines leaking out"
95 (let-keywords* rest #f ()
101 (let-keywords* '(#:foo 123) #f (foo)
108 (with-test-prefix/c&e "let-optional"
110 ;; in guile 1.6.4 and earlier, an empty binding list only used `begin',
111 ;; which caused apparently internal defines to "leak" out into the
112 ;; encompasing environment
113 (pass-if-exception "empty bindings internal defines leaking out"
114 exception:unbound-var
116 (let-optional rest ()
123 (let-optional rest ((foo 999))
130 (with-test-prefix/c&e "let-optional*"
132 ;; in guile 1.6.4 and earlier, an empty binding list only used `begin',
133 ;; which caused apparently internal defines to "leak" out into the
134 ;; encompasing environment
135 (pass-if-exception "empty bindings internal defines leaking out"
136 exception:unbound-var
138 (let-optional* rest ()
145 (let-optional* rest ((foo 999))
148 (define* (foo a b #:optional c (d 1) (e c) f #:key g (h a) (i r) #:rest r)
149 (list a b c d e f g h i r))
151 ;; So we could use lots more tests here, but the fact that lambda* is in
152 ;; the compiler, and the compiler compiles itself, using the evaluator
153 ;; (when bootstrapping) and compiled code (when doing a partial rebuild)
154 ;; makes me a bit complacent.
155 (with-test-prefix/c&e "define*"
156 (pass-if "the whole enchilada"
158 '(1 2 #f 1 #f #f #f 1 () ())))
160 (pass-if-exception "extraneous arguments"
161 exception:extraneous-arguments
162 (let ((f (lambda* (#:key x) x)))
165 (pass-if-exception "unrecognized keyword"
166 exception:unrecognized-keyword
167 (let ((f (lambda* (#:key x) x)))
168 (f #:y 'not-recognized)))
170 (pass-if "rest given before keywords"
171 ;; Passing the rest argument before the keyword arguments should not
172 ;; prevent keyword argument binding.
173 (let ((f (lambda* (#:key x y z #:rest r) (list x y z r))))
174 (equal? (f 1 2 3 #:x 'x #:z 'z)
175 '(x #f z (1 2 3 #:x x #:z z))))))
177 (with-test-prefix/c&e "lambda* inits"
178 (pass-if "can bind lexicals within inits"
181 (lambda* (#:optional a #:key (b (or a 13) #:a))
184 (pass-if "testing qux"
185 (and (equal? (qux) 13)
187 (equal? (qux #:a 2) 2)))
188 (pass-if "nested lambda* with optional"
192 (define* (bar #:optional (y baz))
193 (or (zero? y) (bar (1- y))))
196 (pass-if "nested lambda* with key"
200 (define* (bar #:key (y baz))
201 (or (zero? y) (bar #:y (1- y))))
206 (with-test-prefix/c&e "defmacro*"
207 (pass-if "definition"
209 (defmacro* transmogrify (a #:optional (b 10))
213 (pass-if "explicit arg"
214 (equal? (transmogrify quote 5)
217 (pass-if "default arg"
218 (equal? (transmogrify quote)