[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: Better errors for odd-length keyword args
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 01/01: Better errors for odd-length keyword args |
|
Date: |
Tue, 28 Feb 2017 16:02:30 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit 68f13adaaf3e556cc134b3057086e4e1df8de9ba
Author: Andy Wingo <address@hidden>
Date: Tue Feb 28 20:42:45 2017 +0100
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.
---
libguile/eval.c | 56 ++++++++++++++--------
libguile/keywords.c | 24 ++++++----
libguile/vm-engine.c | 13 +++--
libguile/vm.c | 8 ++--
module/ice-9/eval.scm | 51 ++++++++++++--------
.../standalone/test-scm-c-bind-keyword-arguments.c | 22 ++++-----
test-suite/tests/optargs.test | 16 +++++++
7 files changed, 120 insertions(+), 70 deletions(-)
diff --git a/libguile/eval.c b/libguile/eval.c
index 93788eb..e9ff02a 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -195,6 +195,12 @@ env_set (SCM env, int depth, int width, SCM val)
VECTOR_SET (env, width + 1, val);
}
+static void error_missing_value (SCM proc, SCM kw)
+{
+ scm_error_scm (scm_from_latin1_symbol ("keyword-argument-error"), proc,
+ scm_from_locale_string ("Keyword argument has no value"),
SCM_EOL,
+ scm_list_1 (kw));
+}
static void error_invalid_keyword (SCM proc, SCM obj)
{
@@ -832,28 +838,40 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
{
SCM walk;
- if (scm_is_pair (args) && scm_is_pair (CDR (args)))
- for (; scm_is_pair (args) && scm_is_pair (CDR (args));
- args = CDR (args))
- {
- SCM k = CAR (args), v = CADR (args);
- if (!scm_is_keyword (k))
+ while (scm_is_pair (args))
+ {
+ SCM k = CAR (args);
+ args = CDR (args);
+ if (!scm_is_keyword (k))
+ {
+ if (scm_is_true (rest))
+ continue;
+ else
+ break;
+ }
+ for (walk = kw; scm_is_pair (walk); walk = CDR (walk))
+ if (scm_is_eq (k, CAAR (walk)))
{
- if (scm_is_true (rest))
- continue;
+ if (scm_is_pair (args))
+ {
+ SCM v = CAR (args);
+ args = CDR (args);
+ env_set (env, 0, SCM_I_INUM (CDAR (walk)), v);
+ break;
+ }
else
- break;
+ error_missing_value (proc, k);
}
- for (walk = kw; scm_is_pair (walk); walk = CDR (walk))
- if (scm_is_eq (k, CAAR (walk)))
- {
- env_set (env, 0, SCM_I_INUM (CDAR (walk)), v);
- args = CDR (args);
- break;
- }
- if (scm_is_null (walk) && scm_is_false (aok))
- error_unrecognized_keyword (proc, k);
- }
+ if (scm_is_null (walk))
+ {
+ if (scm_is_false (aok))
+ error_unrecognized_keyword (proc, k);
+ else if (!scm_is_pair (args))
+ /* Advance past argument of unrecognized
+ keyword, if present. */
+ args = CDR (args);
+ }
+ }
if (scm_is_pair (args) && scm_is_false (rest))
error_invalid_keyword (proc, CAR (args));
}
diff --git a/libguile/keywords.c b/libguile/keywords.c
index 0ead336..087042b 100644
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -125,18 +125,12 @@ scm_c_bind_keyword_arguments (const char *subr, SCM rest,
{
va_list va;
- if (SCM_UNLIKELY (!(flags & SCM_ALLOW_NON_KEYWORD_ARGUMENTS)
- && scm_ilength (rest) % 2 != 0))
- scm_error (scm_keyword_argument_error,
- subr, "Odd length of keyword argument list",
- SCM_EOL, SCM_BOOL_F);
-
while (scm_is_pair (rest))
{
SCM kw_or_arg = SCM_CAR (rest);
SCM tail = SCM_CDR (rest);
- if (scm_is_keyword (kw_or_arg) && scm_is_pair (tail))
+ if (scm_is_keyword (kw_or_arg))
{
SCM kw;
SCM *arg_p;
@@ -154,6 +148,11 @@ scm_c_bind_keyword_arguments (const char *subr, SCM rest,
scm_from_latin1_string
("Unrecognized keyword"),
SCM_EOL, scm_list_1 (kw_or_arg));
+
+ /* Advance REST. Advance past the argument of an
+ unrecognized keyword, but don't error if such a
+ keyword has no argument. */
+ rest = scm_is_pair (tail) ? SCM_CDR (tail) : tail;
break;
}
arg_p = va_arg (va, SCM *);
@@ -161,14 +160,19 @@ scm_c_bind_keyword_arguments (const char *subr, SCM rest,
{
/* We found the matching keyword. Store the
associated value and break out of the loop. */
+ if (!scm_is_pair (tail))
+ scm_error_scm (scm_keyword_argument_error,
+ scm_from_locale_string (subr),
+ scm_from_latin1_string
+ ("Keyword argument has no value"),
+ SCM_EOL, scm_list_1 (kw));
*arg_p = SCM_CAR (tail);
+ /* Advance REST. */
+ rest = SCM_CDR (tail);
break;
}
}
va_end (va);
-
- /* Advance REST. */
- rest = SCM_CDR (tail);
}
else
{
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index c9a9cec..9ddda8f 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -1269,9 +1269,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
while (n < ntotal)
FP_SET (n++, SCM_UNDEFINED);
- VM_ASSERT (has_rest || (nkw % 2) == 0,
- vm_error_kwargs_length_not_even (FP_REF (0)));
-
/* Now bind keywords, in the order given. */
for (n = 0; n < nkw; n++)
if (scm_is_keyword (FP_REF (ntotal + n)))
@@ -1281,8 +1278,14 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
if (scm_is_eq (SCM_CAAR (walk), FP_REF (ntotal + n)))
{
SCM si = SCM_CDAR (walk);
- FP_SET (SCM_I_INUMP (si) ? SCM_I_INUM (si) : scm_to_uint32
(si),
- FP_REF (ntotal + n + 1));
+ if (n + 1 < nkw)
+ {
+ FP_SET (SCM_I_INUMP (si) ? SCM_I_INUM (si) :
scm_to_uint32 (si),
+ FP_REF (ntotal + n + 1));
+ }
+ else
+ vm_error_kwargs_missing_value (FP_REF (0),
+ FP_REF (ntotal + n));
break;
}
VM_ASSERT (scm_is_pair (walk) || allow_other_keys,
diff --git a/libguile/vm.c b/libguile/vm.c
index be30517..e8f75b1 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -422,7 +422,7 @@ static void vm_error_bad_instruction (scm_t_uint32 inst)
SCM_NORETURN SCM_NOINLI
static void vm_error_unbound (SCM sym) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_a_variable (const char *func_name, SCM x)
SCM_NORETURN SCM_NOINLINE;
static void vm_error_apply_to_non_list (SCM x) SCM_NORETURN SCM_NOINLINE;
-static void vm_error_kwargs_length_not_even (SCM proc) SCM_NORETURN
SCM_NOINLINE;
+static void vm_error_kwargs_missing_value (SCM proc, SCM kw) SCM_NORETURN
SCM_NOINLINE;
static void vm_error_kwargs_invalid_keyword (SCM proc, SCM obj) SCM_NORETURN
SCM_NOINLINE;
static void vm_error_kwargs_unrecognized_keyword (SCM proc, SCM kw)
SCM_NORETURN SCM_NOINLINE;
static void vm_error_wrong_num_args (SCM proc) SCM_NORETURN SCM_NOINLINE;
@@ -479,11 +479,11 @@ vm_error_apply_to_non_list (SCM x)
}
static void
-vm_error_kwargs_length_not_even (SCM proc)
+vm_error_kwargs_missing_value (SCM proc, SCM kw)
{
scm_error_scm (sym_keyword_argument_error, proc,
- scm_from_latin1_string ("Odd length of keyword argument
list"),
- SCM_EOL, SCM_BOOL_F);
+ scm_from_latin1_string ("Keyword argument has no value"),
+ SCM_EOL, scm_list_1 (kw));
}
static void
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index a2bab20..d21f59a 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))))))))
diff --git a/test-suite/standalone/test-scm-c-bind-keyword-arguments.c
b/test-suite/standalone/test-scm-c-bind-keyword-arguments.c
index f4cd53d..90bcf2b 100644
--- a/test-suite/standalone/test-scm-c-bind-keyword-arguments.c
+++ b/test-suite/standalone/test-scm-c-bind-keyword-arguments.c
@@ -94,33 +94,31 @@ invalid_keyword_error_handler (void *data, SCM key, SCM
args)
}
static SCM
-test_odd_length (void *data)
+test_missing_value (void *data)
{
SCM k_foo = scm_from_utf8_keyword ("foo");
- SCM k_bar = scm_from_utf8_keyword ("bar");
- SCM arg_foo, arg_bar;
+ SCM arg_foo;
scm_c_bind_keyword_arguments ("test",
- scm_list_n (k_foo, SCM_EOL,
- SCM_INUM0,
+ scm_list_n (k_foo,
SCM_UNDEFINED),
SCM_ALLOW_OTHER_KEYS,
k_foo, &arg_foo,
- k_bar, &arg_bar,
SCM_UNDEFINED);
assert (0);
}
static SCM
-odd_length_error_handler (void *data, SCM key, SCM args)
+missing_value_error_handler (void *data, SCM key, SCM args)
{
SCM expected_args = scm_list_n
(scm_from_utf8_string ("test"),
- scm_from_utf8_string ("Odd length of keyword argument list"),
- SCM_EOL, SCM_BOOL_F,
+ scm_from_utf8_string ("Keyword argument has no value"),
+ SCM_EOL, scm_list_1 (scm_from_utf8_keyword ("foo")),
SCM_UNDEFINED);
assert (scm_is_eq (key, scm_from_utf8_symbol ("keyword-argument-error")));
+ scm_write (args, scm_current_output_port ());
assert (scm_is_true (scm_equal_p (args, expected_args)));
return SCM_BOOL_T;
@@ -214,10 +212,10 @@ test_scm_c_bind_keyword_arguments ()
test_invalid_keyword, NULL,
invalid_keyword_error_handler, NULL);
- /* Test odd length error. */
+ /* Test missing value error. */
scm_internal_catch (SCM_BOOL_T,
- test_odd_length, NULL,
- odd_length_error_handler, NULL);
+ test_missing_value, NULL,
+ missing_value_error_handler, NULL);
}
static void
diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test
index 047417b..9590f41 100644
--- a/test-suite/tests/optargs.test
+++ b/test-suite/tests/optargs.test
@@ -154,6 +154,14 @@
(lambda (key proc fmt args data)
data)))
+ (pass-if-equal "missing argument" '("Keyword argument has no value" #:x)
+ (catch 'keyword-argument-error
+ (lambda ()
+ (let ((f (lambda* (#:key x) x)))
+ (f #:x)))
+ (lambda (key proc fmt args data)
+ (cons fmt data))))
+
(pass-if-equal "invalid keyword" '(not-a-keyword)
(catch 'keyword-argument-error
(lambda ()
@@ -178,6 +186,14 @@
(lambda (key proc fmt args data)
data)))
+ (pass-if-equal "missing argument"
+ '("Keyword argument has no value" #:encoding)
+ (catch 'keyword-argument-error
+ (lambda ()
+ (open-file "/dev/null" "r" #:encoding))
+ (lambda (key proc fmt args data)
+ (cons fmt data))))
+
(pass-if-equal "invalid keyword" '(not-a-keyword)
(catch 'keyword-argument-error
(lambda ()