summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/modules.c12
-rw-r--r--test-suite/tests/optargs.test50
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 () ()))))