mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-02 13:00:26 +02:00
84b67e1971
* module/language/tree-il/compile-glil.scm (flatten-lambda): Don't emit
a self-label, because when we can't match the args for a lexical call,
we have no space to shuffle args and jump.
(flatten): Apply the self-tail-call optimization to optional args
too, but only if the procedure is fix-allocated. If we can't apply the
optimization, use the normal tail-call sequence.
* test-suite/tests/optargs.test ("lambda* inits"): Add tests.
219 lines
6.7 KiB
Scheme
219 lines
6.7 KiB
Scheme
;;;; optargs.test --- test suite for optional arg processing -*- scheme -*-
|
|
;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
|
|
;;;;
|
|
;;;; Copyright (C) 2001, 2006, 2009, 2010 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
|
|
;;;; License as published by the Free Software Foundation; either
|
|
;;;; version 3 of the License, or (at your option) any later version.
|
|
;;;;
|
|
;;;; This library is distributed in the hope that it will be useful,
|
|
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;;;; Lesser General Public License for more details.
|
|
;;;;
|
|
;;;; You should have received a copy of the GNU Lesser General Public
|
|
;;;; License along with this library; if not, write to the Free Software
|
|
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
|
|
(define-module (test-suite test-optargs)
|
|
#:use-module (test-suite lib)
|
|
#:use-module (system base compile)
|
|
#:use-module (ice-9 optargs))
|
|
|
|
(define exception:unrecognized-keyword
|
|
'(keyword-argument-error . "Unrecognized keyword"))
|
|
|
|
(define exception:extraneous-arguments
|
|
;; Message depends on whether we use the interpreter or VM, and on the
|
|
;; evenness of the number of extra arguments (!).
|
|
;'(keyword-argument-error . ".*")
|
|
'(#t . ".*"))
|
|
|
|
(define-syntax c&e
|
|
(syntax-rules (pass-if pass-if-exception)
|
|
((_ (pass-if test-name exp))
|
|
(begin (pass-if (string-append test-name " (eval)")
|
|
(primitive-eval 'exp))
|
|
(pass-if (string-append test-name " (compile)")
|
|
(compile 'exp #:to 'value #:env (current-module)))))
|
|
((_ (pass-if-exception test-name exc exp))
|
|
(begin (pass-if-exception (string-append test-name " (eval)")
|
|
exc (primitive-eval 'exp))
|
|
(pass-if-exception (string-append test-name " (compile)")
|
|
exc (compile 'exp #:to 'value
|
|
#:env (current-module)))))))
|
|
|
|
(define-syntax with-test-prefix/c&e
|
|
(syntax-rules ()
|
|
((_ section-name exp ...)
|
|
(with-test-prefix section-name (c&e exp) ...))))
|
|
|
|
(with-test-prefix/c&e "optional argument processing"
|
|
(pass-if "local defines work with optional arguments"
|
|
(eval '(begin
|
|
(define* (test-1 #:optional (x 0))
|
|
(define d 1) ; local define
|
|
#t)
|
|
(false-if-exception (test-1)))
|
|
(interaction-environment))))
|
|
|
|
;;;
|
|
;;; let-keywords
|
|
;;;
|
|
|
|
(with-test-prefix/c&e "let-keywords"
|
|
|
|
;; in guile 1.6.4 and earlier, an empty binding list only used `begin',
|
|
;; which caused apparently internal defines to "leak" out into the
|
|
;; encompasing environment
|
|
(pass-if-exception "empty bindings internal defines leaking out"
|
|
exception:unbound-var
|
|
(let ((rest '()))
|
|
(let-keywords rest #f ()
|
|
(define localvar #f)
|
|
#f)
|
|
localvar))
|
|
|
|
(pass-if "one key"
|
|
(let-keywords '(#:foo 123) #f (foo)
|
|
(= foo 123))))
|
|
|
|
;;;
|
|
;;; let-keywords*
|
|
;;;
|
|
|
|
(with-test-prefix/c&e "let-keywords*"
|
|
|
|
;; in guile 1.6.4 and earlier, an empty binding list only used `begin',
|
|
;; which caused apparently internal defines to "leak" out into the
|
|
;; encompasing environment
|
|
(pass-if-exception "empty bindings internal defines leaking out"
|
|
exception:unbound-var
|
|
(let ((rest '()))
|
|
(let-keywords* rest #f ()
|
|
(define localvar #f)
|
|
#f)
|
|
localvar))
|
|
|
|
(pass-if "one key"
|
|
(let-keywords* '(#:foo 123) #f (foo)
|
|
(= foo 123))))
|
|
|
|
;;;
|
|
;;; let-optional
|
|
;;;
|
|
|
|
(with-test-prefix/c&e "let-optional"
|
|
|
|
;; in guile 1.6.4 and earlier, an empty binding list only used `begin',
|
|
;; which caused apparently internal defines to "leak" out into the
|
|
;; encompasing environment
|
|
(pass-if-exception "empty bindings internal defines leaking out"
|
|
exception:unbound-var
|
|
(let ((rest '()))
|
|
(let-optional rest ()
|
|
(define localvar #f)
|
|
#f)
|
|
localvar))
|
|
|
|
(pass-if "one var"
|
|
(let ((rest '(123)))
|
|
(let-optional rest ((foo 999))
|
|
(= foo 123)))))
|
|
|
|
;;;
|
|
;;; let-optional*
|
|
;;;
|
|
|
|
(with-test-prefix/c&e "let-optional*"
|
|
|
|
;; in guile 1.6.4 and earlier, an empty binding list only used `begin',
|
|
;; which caused apparently internal defines to "leak" out into the
|
|
;; encompasing environment
|
|
(pass-if-exception "empty bindings internal defines leaking out"
|
|
exception:unbound-var
|
|
(let ((rest '()))
|
|
(let-optional* rest ()
|
|
(define localvar #f)
|
|
#f)
|
|
localvar))
|
|
|
|
(pass-if "one var"
|
|
(let ((rest '(123)))
|
|
(let-optional* rest ((foo 999))
|
|
(= foo 123)))))
|
|
|
|
(define* (foo a b #:optional c (d 1) (e c) f #:key g (h a) (i r) #:rest r)
|
|
(list a b c d e f g h i r))
|
|
|
|
;; So we could use lots more tests here, but the fact that lambda* is in
|
|
;; the compiler, and the compiler compiles itself, using the evaluator
|
|
;; (when bootstrapping) and compiled code (when doing a partial rebuild)
|
|
;; makes me a bit complacent.
|
|
(with-test-prefix/c&e "define*"
|
|
(pass-if "the whole enchilada"
|
|
(equal? (foo 1 2)
|
|
'(1 2 #f 1 #f #f #f 1 () ())))
|
|
|
|
(pass-if-exception "extraneous arguments"
|
|
exception:extraneous-arguments
|
|
(let ((f (lambda* (#:key x) x)))
|
|
(f 1 2 #:x 'x)))
|
|
|
|
(pass-if-exception "unrecognized keyword"
|
|
exception:unrecognized-keyword
|
|
(let ((f (lambda* (#:key x) x)))
|
|
(f #:y 'not-recognized)))
|
|
|
|
(pass-if "rest given before keywords"
|
|
;; Passing the rest argument before the keyword arguments should not
|
|
;; prevent keyword argument binding.
|
|
(let ((f (lambda* (#:key x y z #:rest r) (list x y z r))))
|
|
(equal? (f 1 2 3 #:x 'x #:z 'z)
|
|
'(x #f z (1 2 3 #:x x #:z z))))))
|
|
|
|
(with-test-prefix/c&e "lambda* inits"
|
|
(pass-if "can bind lexicals within inits"
|
|
(begin
|
|
(define qux
|
|
(lambda* (#:optional a #:key (b (or a 13) #:a))
|
|
b))
|
|
#t))
|
|
(pass-if "testing qux"
|
|
(and (equal? (qux) 13)
|
|
(equal? (qux 1) 1)
|
|
(equal? (qux #:a 2) 2)))
|
|
(pass-if "nested lambda* with optional"
|
|
(begin
|
|
(define (foo x)
|
|
(define baz x)
|
|
(define* (bar #:optional (y baz))
|
|
(or (zero? y) (bar (1- y))))
|
|
(bar))
|
|
(foo 10)))
|
|
(pass-if "nested lambda* with key"
|
|
(begin
|
|
(define (foo x)
|
|
(define baz x)
|
|
(define* (bar #:key (y baz))
|
|
(or (zero? y) (bar #:y (1- y))))
|
|
(bar))
|
|
(foo 10))))
|
|
|
|
|
|
(with-test-prefix/c&e "defmacro*"
|
|
(pass-if "definition"
|
|
(begin
|
|
(defmacro* transmogrify (a #:optional (b 10))
|
|
`(,a ,b))
|
|
#t))
|
|
|
|
(pass-if "explicit arg"
|
|
(equal? (transmogrify quote 5)
|
|
5))
|
|
|
|
(pass-if "default arg"
|
|
(equal? (transmogrify quote)
|
|
10)))
|