diff options
-rw-r--r-- | libguile/modules.c | 12 | ||||
-rw-r--r-- | test-suite/tests/optargs.test | 50 |
2 files changed, 50 insertions, 12 deletions
diff --git a/libguile/modules.c b/libguile/modules.c index deae23a59..c7f0a46b0 100644 --- a/libguile/modules.c +++ b/libguile/modules.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008 Free Software Foundation, Inc. +/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008,2009 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 @@ -46,6 +46,12 @@ static SCM the_module; static SCM the_root_module_var; +static SCM unbound_variable (const char *func, SCM sym) +{ + scm_error (scm_from_locale_symbol ("unbound-variable"), func, + "Unbound variable: ~S", scm_list_1 (sym), SCM_BOOL_F); +} + static SCM the_root_module () { @@ -740,7 +746,7 @@ scm_module_lookup (SCM module, SCM sym) var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F); if (scm_is_false (var)) - SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (sym)); + unbound_variable (FUNC_NAME, sym); return var; } #undef FUNC_NAME @@ -757,7 +763,7 @@ scm_lookup (SCM sym) SCM var = scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F); if (scm_is_false (var)) - scm_misc_error ("scm_lookup", "unbound variable: ~S", scm_list_1 (sym)); + unbound_variable (NULL, sym); return var; } diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test index 5929ce909..f8459ba0e 100644 --- a/test-suite/tests/optargs.test +++ b/test-suite/tests/optargs.test @@ -1,7 +1,7 @@ ;;;; optargs.test --- test suite for optional arg processing -*- scheme -*- ;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001 ;;;; -;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006, 2009 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 @@ -18,10 +18,30 @@ ;;;; 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 (ice-9 optargs)) - -(with-test-prefix "optional argument processing" + #:use-module (test-suite lib) + #:use-module (system base compile) + #:use-module (ice-9 optargs)) + +(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)) @@ -34,7 +54,7 @@ ;;; let-keywords ;;; -(with-test-prefix "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 @@ -55,7 +75,7 @@ ;;; let-keywords* ;;; -(with-test-prefix "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 @@ -76,7 +96,7 @@ ;;; let-optional ;;; -(with-test-prefix "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 @@ -98,7 +118,7 @@ ;;; let-optional* ;;; -(with-test-prefix "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 @@ -115,3 +135,15 @@ (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 () ())))) |