diff options
author | Andy Wingo <wingo@pobox.com> | 2017-02-28 20:42:45 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2017-02-28 22:01:20 +0100 |
commit | 68f13adaaf3e556cc134b3057086e4e1df8de9ba (patch) | |
tree | c28824cae91f4495fa71c4170c97d88a54dbcdd1 /module | |
parent | 33514ffe22b8cd15ff7ba95bcee80a534b2bbc2a (diff) |
Better errors for odd-length keyword args
* libguile/vm-engine.c (bind-kwargs):
* libguile/vm.c (vm_error_kwargs_missing_value):
* libguile/eval.c (error_missing_value)
(prepare_boot_closure_env_for_apply): Adapt to mirror VM behavior.
* libguile/keywords.c (scm_c_bind_keyword_arguments): Likewise.
* module/ice-9/eval.scm (primitive-eval): Update to error on (foo #:kw)
with a "Keyword argument has no value" instead of the horrible "odd
argument list length". Also adapts to the expected args format for
the keyword-argument-error exception printer in all cases. Matches
1.8 optargs behavior also.
* test-suite/standalone/test-scm-c-bind-keyword-arguments.c (test_missing_value):
(missing_value_error_handler): Update test.
* test-suite/tests/optargs.test: Add tests.
Diffstat (limited to 'module')
-rw-r--r-- | module/ice-9/eval.scm | 51 |
1 files changed, 31 insertions, 20 deletions
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm index a2bab2065..d21f59abd 100644 --- a/module/ice-9/eval.scm +++ b/module/ice-9/eval.scm @@ -498,27 +498,38 @@ (define (bind-kw args) (let lp ((args args)) (cond - ((and (pair? args) (pair? (cdr args)) - (keyword? (car args))) - (let ((kw-pair (assq (car args) keywords)) - (v (cadr args))) - (if kw-pair - ;; Found a known keyword; set its value. - (env-set! env 0 (cdr kw-pair) v) - ;; Unknown keyword. - (if (not allow-other-keys?) - ((scm-error - 'keyword-argument-error - "eval" "Unrecognized keyword" - '() (list (car args)))))) - (lp (cddr args)))) ((pair? args) - (if rest? - ;; Be lenient parsing rest args. - (lp (cdr args)) - ((scm-error 'keyword-argument-error - "eval" "Invalid keyword" - '() (list (car args)))))) + (cond + ((keyword? (car args)) + (let ((k (car args)) + (args (cdr args))) + (cond + ((assq k keywords) + => (lambda (kw-pair) + ;; Found a known keyword; set its value. + (if (pair? args) + (let ((v (car args)) + (args (cdr args))) + (env-set! env 0 (cdr kw-pair) v) + (lp args)) + ((scm-error 'keyword-argument-error + "eval" + "Keyword argument has no value" + '() (list k)))))) + ;; Otherwise unknown keyword. + (allow-other-keys? + (lp (if (pair? args) (cdr args) args))) + (else + ((scm-error 'keyword-argument-error + "eval" "Unrecognized keyword" + '() (list k))))))) + (rest? + ;; Be lenient parsing rest args. + (lp (cdr args))) + (else + ((scm-error 'keyword-argument-error + "eval" "Invalid keyword" + '() (list (car args))))))) (else (body env))))) (bind-req args)))))))) |