mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

add some optargs tests

Browse source 
* libguile/modules.c (scm_module_lookup, scm_lookup): Throw to
  'unbound-variable, like eval.i.c does.

* test-suite/tests/optargs.test: Add an optargs test. Run optargs tests
  under both the VM and the interpreter.
This commit is contained in:
Andy Wingo 2009-10-23 15:47:08 +02:00
parent 3092a14d67
commit 7ab42fa20c
2 changed files with 49 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

12
libguile/modules.c
View file

@ -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;
}

48
test-suite/tests/optargs.test
View file

@ -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))
#:use-module (test-suite lib)
#:use-module (system base compile)
#:use-module (ice-9 optargs))
(with-test-prefix "optional argument processing"
(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 () ()))))