Better errors for odd-length keyword args

* libguile/vm-i-system.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

@@ -162,6 +162,13 @@ static void error_used_before_defined (void)
              "Variable used before given a value", SCM_EOL, SCM_BOOL_F);
 }
 
+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)
 {
   scm_error_scm (scm_from_latin1_symbol ("keyword-argument-error"), proc,
@@ -867,18 +874,17 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
           {
             int imax = i - 1;
             int kw_start_idx = i;
-            SCM walk, k, v;
+            SCM walk, k;
             for (walk = kw; scm_is_pair (walk); walk = CDR (walk))
               if (SCM_I_INUM (CDAR (walk)) > imax)
                 imax = SCM_I_INUM (CDAR (walk));
             for (; i <= imax; i++)
               env = scm_cons (SCM_UNDEFINED, env);
 
-            if (scm_is_pair (args) && scm_is_pair (CDR (args)))
+            while (scm_is_pair (args))
-              for (; scm_is_pair (args) && scm_is_pair (CDR (args));
-                   args = CDR (args))
               {
-                  k = CAR (args); v = CADR (args);
+                k = CAR (args);
+                args = CDR (args);
                 if (!scm_is_keyword (k))
                   {
                     if (scm_is_true (rest))
@@ -892,12 +898,24 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args,
                       /* Well... ok, list-set! isn't the nicest interface, but
                          hey. */
                       int iset = imax - SCM_I_INUM (CDAR (walk));
-                        scm_list_set_x (env, SCM_I_MAKINUM (iset), v);
+                      if (scm_is_pair (args))
+                        {
+                          SCM v = CAR (args);
                           args = CDR (args);
+                          scm_list_set_x (env, SCM_I_MAKINUM (iset), v);
                           break;
                         }
-                  if (scm_is_null (walk) && scm_is_false (aok))
+                      else
+                        error_missing_value (proc, k);
+                    }
+                if (scm_is_null (walk))
+                  {
+                    if (scm_is_false (aok))
                       error_unrecognized_keyword (proc, k);
+                    /* Advance past argument of unknown keyword.  */
+                    if (scm_is_pair (args))
+                      args = CDR (args);
+                  }
               }
             if (scm_is_pair (args) && scm_is_false (rest))
               error_invalid_keyword (proc, CAR (args));

libguile/keywords.c

@@ -134,18 +134,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;
@@ -163,6 +157,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 *);
@@ -170,14 +169,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
         {

libguile/vm-i-system.c

@@ -658,15 +658,11 @@ VM_DEFINE_INSTRUCTION (48, bind_kwargs, "bind-kwargs", 5, 0, 0)
   nkw += FETCH ();
   kw_and_rest_flags = FETCH ();
 
-  VM_ASSERT ((kw_and_rest_flags & F_REST)
-             || ((sp - (fp - 1) - nkw) % 2) == 0,
-             vm_error_kwargs_length_not_even (program))
-
   CHECK_OBJECT (idx);
   kw = OBJECT_REF (idx);
 
   /* Switch NKW to be a negative index below SP.  */
-  for (nkw = -(sp - (fp - 1) - nkw) + 1; nkw < 0; nkw++)
+  for (nkw = -(sp - (fp - 1) - nkw) + 1; nkw <= 0; nkw++)
     {
       SCM walk;
 
@@ -677,6 +673,9 @@ VM_DEFINE_INSTRUCTION (48, bind_kwargs, "bind-kwargs", 5, 0, 0)
 	      if (scm_is_eq (SCM_CAAR (walk), sp[nkw]))
 		{
 		  SCM si = SCM_CDAR (walk);
+                  VM_ASSERT (nkw != 0
+                             || (kw_and_rest_flags & F_ALLOW_OTHER_KEYS),
+                             vm_error_kwargs_missing_value (program, sp[nkw]));
 		  LOCAL_SET (SCM_I_INUMP (si) ? SCM_I_INUM (si) : scm_to_long (si),
 			     sp[nkw + 1]);
 		  break;

libguile/vm.c

@@ -384,7 +384,7 @@ static void vm_error_unbound_fluid (SCM proc, SCM fluid) SCM_NORETURN;
 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_missing_value (SCM proc, SCM kw) 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;
@@ -462,11 +462,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_from_latin1_string ("Keyword argument has no value"),
-                 SCM_EOL, SCM_BOOL_F);
+                 SCM_EOL, scm_list_1 (kw));
 }
 
 static void

module/ice-9/eval.scm

@@ -338,28 +338,42 @@
                                          env))))
                          ;; Now scan args for keywords.
                          (let lp ((args args))
-                           (if (and (pair? args) (pair? (cdr args))
+                           (cond
-                                    (keyword? (car args)))
+                            ((pair? args)
-                               (let ((kw-pair (assq (car args) kw))
+                             (cond
-                                     (v (cadr args)))
+                              ((keyword? (car args))
-                                 (if kw-pair
+                               (let ((k (car args))
+                                     (args (cdr args)))
+                                 (cond
+                                  ((assq k kw)
+                                   => (lambda (kw-pair)
                                         ;; Found a known keyword; set its value.
-                                     (list-set! env
-                                                (- imax (cdr kw-pair)) v)
-                                     ;; Unknown keyword.
-                                     (if (not aok)
-                                         (scm-error
-                                          'keyword-argument-error
-                                          "eval" "Unrecognized keyword"
-                                          '() (list (car args)))))
-                                 (lp (cddr args)))
                                         (if (pair? args)
-                                   (if rest?
+                                            (let ((v (car args))
+                                                  (args (cdr args)))
+                                              (list-set! env
+                                                         (- imax (cdr kw-pair))
+                                                         v)
+                                              (lp args))
+                                            (scm-error 'keyword-argument-error
+                                                       "eval"
+                                                       "Keyword argument has no value"
+                                                       '() (list k)))))
+                                  ;; Otherwise unknown keyword.
+                                  (aok
+                                   (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))
+                               (lp (cdr args)))
+                              (else
                                (scm-error 'keyword-argument-error
                                           "eval" "Invalid keyword"
-                                                  '() (list (car args))))
+                                          '() (list (car args))))))
+                            (else
                              ;; Finished parsing keywords. Fill in
                              ;; uninitialized kwargs by evalling init
                              ;; expressions in their appropriate
@@ -374,7 +388,8 @@
                                                          (cdr tail))))
                                      (lp (1- i) (cdr inits)))
                                    ;; Finally, eval the body.
-                                         (eval body env))))))))))))))))
+                                   (eval body env)))))
+                           )))))))))))
 
     ;; The "engine". EXP is a memoized expression.
     (define (eval exp env)

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;
-  SCM arg_foo, arg_bar;
 
   scm_c_bind_keyword_arguments ("test",
-                                scm_list_n (k_foo, SCM_EOL,
+                                scm_list_n (k_foo,
-                                            SCM_INUM0,
                                             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_from_utf8_string ("Keyword argument has no value"),
-     SCM_EOL, SCM_BOOL_F,
+     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,
+                      test_missing_value, NULL,
-                      odd_length_error_handler, NULL);
+                      missing_value_error_handler, NULL);
 }
 
 static void

test-suite/tests/00-repl-server.test

@@ -99,6 +99,7 @@ reached."
 ;;; Since we call 'primitive-fork', these tests must run before any
 ;;; tests that create threads.
 
+#;
 (with-test-prefix "repl-server"
 
   (pass-if-equal "simple expression"

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