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.
This commit is contained in:
Andy Wingo 2017-02-28 20:42:45 +01:00
commit 68f13adaaf
7 changed files with 120 additions and 70 deletions

View file

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

View file

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

View file

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

View file

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