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.

4 files changed, 63 insertions, 38 deletions

diff --git a/libguile/eval.c b/libguile/eval.c
index 93788ebfc..e9ff02a8b 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 0ead33692..087042b84 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 c9a9cecd1..9ddda8f2a 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 be30517c5..e8f75b14f 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