summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-06-04 00:29:59 +0200
committerLudovic Courtès <ludo@gnu.org>2013-06-04 12:08:02 +0200
commit4af0d97ee65f298be33d5959cd36a5bea8797be9 (patch)
tree863824da077e6800145db2b8f3cc10c3c551ce9a
parent6fe2803b45fbbd676625c9d665151e5a8a57aca5 (diff)
downloadguile-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.texi3
-rw-r--r--libguile/error.c3
-rw-r--r--libguile/eval.c12
-rw-r--r--libguile/vm-i-system.c4
-rw-r--r--libguile/vm.c12
-rw-r--r--module/ice-9/boot-9.scm7
-rw-r--r--module/ice-9/eval.scm4
-rw-r--r--test-suite/tests/optargs.test38
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