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, 2013 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:invalid-keyword
26 '(keyword-argument-error . "Invalid keyword"))
28 (define exception:unrecognized-keyword
29 '(keyword-argument-error . "Unrecognized keyword"))
31 (define exception:extraneous-arguments
32 ;; Message depends on whether we use the interpreter or VM, and on the
33 ;; evenness of the number of extra arguments (!).
34 ;'(keyword-argument-error . ".*")
37 (with-test-prefix/c&e "optional argument processing"
38 (pass-if "local defines work with optional arguments"
40 (define* (test-1 #:optional (x 0))
41 (define d 1) ; local define
43 (false-if-exception (test-1)))
44 (interaction-environment))))
50 (with-test-prefix/c&e "let-keywords"
52 ;; in guile 1.6.4 and earlier, an empty binding list only used `begin',
53 ;; which caused apparently internal defines to "leak" out into the
54 ;; encompasing environment
55 (pass-if-exception "empty bindings internal defines leaking out"
58 (let-keywords rest #f ()
64 (let-keywords '(#:foo 123) #f (foo)
71 (with-test-prefix/c&e "let-keywords*"
73 ;; in guile 1.6.4 and earlier, an empty binding list only used `begin',
74 ;; which caused apparently internal defines to "leak" out into the
75 ;; encompasing environment
76 (pass-if-exception "empty bindings internal defines leaking out"
79 (let-keywords* rest #f ()
85 (let-keywords* '(#:foo 123) #f (foo)
92 (with-test-prefix/c&e "let-optional"
94 ;; in guile 1.6.4 and earlier, an empty binding list only used `begin',
95 ;; which caused apparently internal defines to "leak" out into the
96 ;; encompasing environment
97 (pass-if-exception "empty bindings internal defines leaking out"
100 (let-optional rest ()
107 (let-optional rest ((foo 999))
114 (with-test-prefix/c&e "let-optional*"
116 ;; in guile 1.6.4 and earlier, an empty binding list only used `begin',
117 ;; which caused apparently internal defines to "leak" out into the
118 ;; encompasing environment
119 (pass-if-exception "empty bindings internal defines leaking out"
120 exception:unbound-var
122 (let-optional* rest ()
129 (let-optional* rest ((foo 999))
132 (define* (foo a b #:optional c (d 1) (e c) f #:key g (h a) (i r) #:rest r)
133 (list a b c d e f g h i r))
135 ;; So we could use lots more tests here, but the fact that lambda* is in
136 ;; the compiler, and the compiler compiles itself, using the evaluator
137 ;; (when bootstrapping) and compiled code (when doing a partial rebuild)
138 ;; makes me a bit complacent.
139 (with-test-prefix/c&e "define*"
140 (pass-if "the whole enchilada"
142 '(1 2 #f 1 #f #f #f 1 () ())))
144 (pass-if-exception "extraneous arguments"
145 exception:extraneous-arguments
146 (let ((f (lambda* (#:key x) x)))
149 (pass-if-equal "unrecognized keyword" '(#:y)
150 (catch 'keyword-argument-error
152 (let ((f (lambda* (#:key x) x)))
153 (f #:y 'not-recognized)))
154 (lambda (key proc fmt args data)
157 (pass-if-equal "invalid keyword" '(not-a-keyword)
158 (catch 'keyword-argument-error
160 (let ((f (lambda* (#:key x) x)))
161 (f 'not-a-keyword 'something)))
162 (lambda (key proc fmt args data)
165 (pass-if "rest given before keywords"
166 ;; Passing the rest argument before the keyword arguments should not
167 ;; prevent keyword argument binding.
168 (let ((f (lambda* (#:key x y z #:rest r) (list x y z r))))
169 (equal? (f 1 2 3 #:x 'x #:z 'z)
170 '(x #f z (1 2 3 #:x x #:z z))))))
172 (with-test-prefix "scm_c_bind_keyword_arguments"
174 (pass-if-equal "unrecognized keyword" '(#:y)
175 (catch 'keyword-argument-error
177 (open-file "/dev/null" "r" #:y 'not-recognized))
178 (lambda (key proc fmt args data)
181 (pass-if-equal "invalid keyword" '(not-a-keyword)
182 (catch 'keyword-argument-error
184 (open-file "/dev/null" "r" 'not-a-keyword 'something))
185 (lambda (key proc fmt args data)
188 (with-test-prefix/c&e "lambda* inits"
189 (pass-if "can bind lexicals within inits"
192 (lambda* (#:optional a #:key (b (or a 13) #:a))
195 (pass-if "testing qux"
196 (and (equal? (qux) 13)
198 (equal? (qux #:a 2) 2)))
199 (pass-if "nested lambda* with optional"
203 (define* (bar #:optional (y baz))
204 (or (zero? y) (bar (1- y))))
207 (pass-if "nested lambda* with key"
211 (define* (bar #:key (y baz))
212 (or (zero? y) (bar #:y (1- y))))
217 (with-test-prefix/c&e "defmacro*"
218 (pass-if "definition"
220 (defmacro* transmogrify (a #:optional (b 10))
224 (pass-if "explicit arg"
225 (equal? (transmogrify quote 5)
228 (pass-if "default arg"
229 (equal? (transmogrify quote)
232 (with-test-prefix/c&e "case-lambda"
233 (pass-if-exception "no clauses, no args" exception:wrong-num-args
236 (pass-if-exception "no clauses, args" exception:wrong-num-args
240 (equal? "docstring test"
241 (procedure-documentation
247 (with-test-prefix/c&e "case-lambda*"
248 (pass-if-exception "no clauses, no args" exception:wrong-num-args
251 (pass-if-exception "no clauses, args" exception:wrong-num-args
255 (equal? "docstring test"
256 (procedure-documentation
262 (pass-if "unambiguous"
268 (pass-if "unambiguous (reversed)"
274 (pass-if "optionals (order disambiguates)"
276 ((a #:optional b) #t)
280 (pass-if "optionals (order disambiguates (2))"
283 ((a #:optional b) #f))
286 (pass-if "optionals (one arg)"
289 ((a #:optional b) #t))
292 (pass-if "optionals (one arg (2))"
294 ((a #:optional b) #t)
298 (pass-if "keywords without keyword"
304 (pass-if "keywords with keyword"
310 (pass-if "keywords (too many positionals)"
316 (pass-if "keywords (order disambiguates)"
322 (pass-if "keywords (order disambiguates (2))"