mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Print the faulty object upon invalid-keyword errors.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2013-06-04 00:29:59 +02:00
parent 6fe2803b45
commit 4af0d97ee6
8 changed files with 41 additions and 42 deletions
Download patch file Download diff file Expand all files Collapse all files

3
doc/ref/api-control.texi
View file

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

3
libguile/error.c
View file

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

12
libguile/eval.c
View file

@ -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. */

4
libguile/vm-i-system.c
View file

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

12
libguile/vm.c
View file

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

7
module/ice-9/boot-9.scm
View file

@ -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)

4
module/ice-9/eval.scm
View file

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

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

@ -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
(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