[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] Print the faulty object upon invalid-keyword errors.
|
From: |
ludo |
|
Subject: |
[PATCH] Print the faulty object upon invalid-keyword errors. |
|
Date: |
Tue, 4 Jun 2013 00:33:05 +0200 |
From: Ludovic Courtès <address@hidden>
* 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.
* 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.
---
doc/ref/api-control.texi | 3 ++-
libguile/error.c | 3 ++-
libguile/eval.c | 12 ++++++------
libguile/vm-i-system.c | 4 ++--
libguile/vm.c | 12 ++++++------
module/ice-9/boot-9.scm | 7 ++++++-
module/ice-9/eval.scm | 4 ++--
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 56ffba2..7ffb3f7 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
address@hidden is @code{out-of-range} or @code{wrong-type-arg},
address@hidden 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 0df4c73..26cf5b6 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 0526f07..6047d6d 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 34545dd..e54a99b 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 6a4ecd8..62c1d6d 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 0779d27..a55fb61 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 554c88e..c971113 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 16a4533..b8f21c4 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
--
1.7.10.4
- [PATCH] Print the faulty object upon invalid-keyword errors.,
ludo <=