diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-06-04 00:29:59 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-06-04 12:08:02 +0200 |
commit | 4af0d97ee65f298be33d5959cd36a5bea8797be9 (patch) | |
tree | 863824da077e6800145db2b8f3cc10c3c551ce9a | |
parent | 6fe2803b45fbbd676625c9d665151e5a8a57aca5 (diff) | |
download | guile-4af0d97ee65f298be33d5959cd36a5bea8797be9.tar.gz |
Print the faulty object upon invalid-keyword errors.
* libguile/vm.c (vm_error_kwargs_invalid_keyword,
vm_error_kwargs_unrecognized_keyword): Add parameter. Pass it
enclosed in a list as the last argument to `scm_error_scm'.
* libguile/vm-i-system.c (bind_kwargs): Adjust accordingly.
* libguile/eval.c (error_invalid_keyword, error_unrecognized_keyword):
Add parameter.
(prepare_boot_closure_env_for_apply): Adjust accordingly.
* module/ice-9/eval.scm (primitive-eval): Likewise.
* libguile/error.c (scm_error_scm): Mention `keyword-argument-error' in
docstring.
* module/ice-9/boot-9.scm (keyword-error-printer): New procedure; use it.
* test-suite/tests/optargs.test (c&e, with-test-prefix/c&e): Remove.
("define*")["unrecognized keyword"]: Test the value passed along the
`keyword-argument-error' exception.
["invalid keyword"]: New test.
* doc/ref/api-control.texi (Error Reporting): Update `scm-error'
description.
-rw-r--r-- | doc/ref/api-control.texi | 3 | ||||
-rw-r--r-- | libguile/error.c | 3 | ||||
-rw-r--r-- | libguile/eval.c | 12 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 4 | ||||
-rw-r--r-- | libguile/vm.c | 12 | ||||
-rw-r--r-- | module/ice-9/boot-9.scm | 7 | ||||
-rw-r--r-- | module/ice-9/eval.scm | 4 | ||||
-rw-r--r-- | test-suite/tests/optargs.test | 38 |
8 files changed, 41 insertions, 42 deletions
diff --git a/doc/ref/api-control.texi b/doc/ref/api-control.texi index 56ffba26b..7ffb3f740 100644 --- a/doc/ref/api-control.texi +++ b/doc/ref/api-control.texi @@ -1421,7 +1421,8 @@ Guile) formats using @code{display} and @code{~S} (was @code{system-error} then it should be a list containing the Unix @code{errno} value; If @var{key} is @code{signal} then it should be a list containing the Unix signal number; If -@var{key} is @code{out-of-range} or @code{wrong-type-arg}, +@var{key} is @code{out-of-range}, @code{wrong-type-arg}, +or @code{keyword-argument-error}, it is a list containing the bad value; otherwise it will usually be @code{#f}. @end deffn diff --git a/libguile/error.c b/libguile/error.c index 0df4c737e..26cf5b6d6 100644 --- a/libguile/error.c +++ b/libguile/error.c @@ -80,7 +80,8 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0, "@code{system-error} then it should be a list containing the\n" "Unix @code{errno} value; If @var{key} is @code{signal} then it\n" "should be a list containing the Unix signal number; If\n" - "@var{key} is @code{out-of-range} or @code{wrong-type-arg},\n" + "@var{key} is @code{out-of-range}, @code{wrong-type-arg},\n" + "or @code{keyword-argument-error}, " "it is a list containing the bad value; otherwise\n" "it will usually be @code{#f}.") #define FUNC_NAME s_scm_error_scm diff --git a/libguile/eval.c b/libguile/eval.c index 0526f078d..6047d6d75 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -162,18 +162,18 @@ static void error_used_before_defined (void) "Variable used before given a value", SCM_EOL, SCM_BOOL_F); } -static void error_invalid_keyword (SCM proc) +static void error_invalid_keyword (SCM proc, SCM obj) { scm_error_scm (scm_from_latin1_symbol ("keyword-argument-error"), proc, scm_from_locale_string ("Invalid keyword"), SCM_EOL, - SCM_BOOL_F); + scm_list_1 (obj)); } -static void error_unrecognized_keyword (SCM proc) +static void error_unrecognized_keyword (SCM proc, SCM kw) { scm_error_scm (scm_from_latin1_symbol ("keyword-argument-error"), proc, scm_from_locale_string ("Unrecognized keyword"), SCM_EOL, - SCM_BOOL_F); + scm_list_1 (kw)); } @@ -890,10 +890,10 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args, break; } if (scm_is_null (walk) && scm_is_false (aok)) - error_unrecognized_keyword (proc); + error_unrecognized_keyword (proc, k); } if (scm_is_pair (args) && scm_is_false (rest)) - error_invalid_keyword (proc); + error_invalid_keyword (proc, CAR (args)); /* Now fill in unbound values, evaluating init expressions in their appropriate environment. */ diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 34545ddf4..e54a99ba6 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -681,12 +681,12 @@ VM_DEFINE_INSTRUCTION (48, bind_kwargs, "bind-kwargs", 5, 0, 0) } VM_ASSERT (scm_is_pair (walk) || (kw_and_rest_flags & F_ALLOW_OTHER_KEYS), - vm_error_kwargs_unrecognized_keyword (program)); + vm_error_kwargs_unrecognized_keyword (program, sp[nkw])); nkw++; } else VM_ASSERT (kw_and_rest_flags & F_REST, - vm_error_kwargs_invalid_keyword (program)); + vm_error_kwargs_invalid_keyword (program, sp[nkw])); } NEXT; diff --git a/libguile/vm.c b/libguile/vm.c index 6a4ecd8e4..62c1d6d88 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -385,8 +385,8 @@ static void vm_error_not_a_variable (const char *func_name, SCM x) SCM_NORETURN; static void vm_error_not_a_thunk (const char *func_name, SCM x) SCM_NORETURN; static void vm_error_apply_to_non_list (SCM x) SCM_NORETURN; static void vm_error_kwargs_length_not_even (SCM proc) SCM_NORETURN; -static void vm_error_kwargs_invalid_keyword (SCM proc) SCM_NORETURN; -static void vm_error_kwargs_unrecognized_keyword (SCM proc) SCM_NORETURN; +static void vm_error_kwargs_invalid_keyword (SCM proc, SCM obj) SCM_NORETURN; +static void vm_error_kwargs_unrecognized_keyword (SCM proc, SCM kw) SCM_NORETURN; static void vm_error_too_many_args (int nargs) SCM_NORETURN; static void vm_error_wrong_num_args (SCM proc) SCM_NORETURN; static void vm_error_wrong_type_apply (SCM proc) SCM_NORETURN; @@ -471,19 +471,19 @@ vm_error_kwargs_length_not_even (SCM proc) } static void -vm_error_kwargs_invalid_keyword (SCM proc) +vm_error_kwargs_invalid_keyword (SCM proc, SCM obj) { scm_error_scm (sym_keyword_argument_error, proc, scm_from_latin1_string ("Invalid keyword"), - SCM_EOL, SCM_BOOL_F); + SCM_EOL, scm_list_1 (obj)); } static void -vm_error_kwargs_unrecognized_keyword (SCM proc) +vm_error_kwargs_unrecognized_keyword (SCM proc, SCM kw) { scm_error_scm (sym_keyword_argument_error, proc, scm_from_latin1_string ("Unrecognized keyword"), - SCM_EOL, SCM_BOOL_F); + SCM_EOL, scm_list_1 (kw)); } static void diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 0779d27ea..c825b3530 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -944,12 +944,17 @@ procedures, their behavior is implementation dependent." (_ (default-printer))) args)) + (define (keyword-error-printer port key args default-printer) + (let ((message (cadr args)) + (faulty (car (cadddr args)))) ; I won't do it again, I promise. + (format port "~a: ~s" message faulty))) + (define (getaddrinfo-error-printer port key args default-printer) (format port "In procedure getaddrinfo: ~a" (gai-strerror (car args)))) (set-exception-printer! 'goops-error scm-error-printer) (set-exception-printer! 'host-not-found scm-error-printer) - (set-exception-printer! 'keyword-argument-error scm-error-printer) + (set-exception-printer! 'keyword-argument-error keyword-error-printer) (set-exception-printer! 'misc-error scm-error-printer) (set-exception-printer! 'no-data scm-error-printer) (set-exception-printer! 'no-recovery scm-error-printer) diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm index 554c88e56..c9711134c 100644 --- a/module/ice-9/eval.scm +++ b/module/ice-9/eval.scm @@ -351,7 +351,7 @@ (scm-error 'keyword-argument-error "eval" "Unrecognized keyword" - '() #f))) + '() (list (car args))))) (lp (cddr args))) (if (pair? args) (if rest? @@ -359,7 +359,7 @@ (lp (cdr args)) (scm-error 'keyword-argument-error "eval" "Invalid keyword" - '() #f)) + '() (list (car args)))) ;; Finished parsing keywords. Fill in ;; uninitialized kwargs by evalling init ;; expressions in their appropriate diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test index 16a45336a..b8f21c470 100644 --- a/test-suite/tests/optargs.test +++ b/test-suite/tests/optargs.test @@ -34,25 +34,6 @@ ;'(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 @@ -165,10 +146,21 @@ (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-equal "unrecognized keyword" '(#:y) + (catch 'keyword-argument-error + (lambda () + (let ((f (lambda* (#:key x) x))) + (f #:y 'not-recognized))) + (lambda (key proc fmt args data) + data))) + + (pass-if-equal "invalid keyword" '(not-a-keyword) + (catch 'keyword-argument-error + (lambda () + (let ((f (lambda* (#:key x) x))) + (f 'not-a-keyword 'something))) + (lambda (key proc fmt args data) + data))) (pass-if "rest given before keywords" ;; Passing the rest argument before the keyword arguments should not |