Improve &key parsing errors

Bike · Bike · commit 8bb1ac91c4ba · 2023-03-06T18:36:14.000-05:00
1) report all unknown keywords, not just the first. This conses
   but it's a slow error path so who cares?
2) Detect and report odd keyword arguments in the bytecode. This
   was causing weird memory leak problems: the unrecognized keyword
   slot of the signaled unrecognized-keyword condition was junk.
diff --git a/include/clasp/core/exceptions.h b/include/clasp/core/exceptions.h
@@ -261,7 +261,8 @@ void throwTooFewArgumentsError(core::T_sp closure,size_t given, size_t required)
 
 void throwTooManyArgumentsError(core::T_sp closure, size_t given, size_t required);
 
-void throwUnrecognizedKeywordArgumentError(core::T_sp closure, T_sp kw);
+void throwOddKeywordsError(core::T_sp closure);
+void throwUnrecognizedKeywordArgumentError(core::T_sp closure, core::T_sp kw);
 
 void wrongNumberOfArguments(core::T_sp closure, size_t givenNumberOfArguments, size_t requiredNumberOfArguments);
 
diff --git a/src/core/bytecode.cc b/src/core/bytecode.cc
@@ -484,14 +484,18 @@ static gctools::return_type bytecode_vm(VirtualMachine& vm,
              more_start, key_count_info, key_literal_start, key_frame_start);
       uint8_t key_count = key_count_info & 0x7f;
       bool ll_aokp = key_count_info & 0x80;
-      bool seen_aokp = false;
       bool aokp = false;
-      bool unknown_key_p = false;
-      T_O* unknown_key = unbound<T_O>().raw_();
+      T_sp unknown_keys = nil<T_O>();
       // Set keyword arguments to unbound.
       vm.fillreg(fp, unbound<T_O>().raw_(), key_count, key_frame_start);
       if (lcc_nargs > more_start) {
-        // FIXME: Check for odd keyword portion
+        if (((lcc_nargs - more_start) % 2) != 0) {
+          T_sp tclosure((gctools::Tagged)gctools::tag_general(closure));
+          throwOddKeywordsError(tclosure);
+        }
+        // We grab keyword arguments from the end to the beginning.
+        // This means that earlier arguments are put in their variables
+        // last, matching the CL semantics.
         // KLUDGE: We use a signed type so that if more_start is zero we don't
         // wrap arg_index around. There's probably a cleverer solution.
         ptrdiff_t arg_index;
@@ -502,7 +506,7 @@ static gctools::return_type bytecode_vm(VirtualMachine& vm,
           if (key == kw::_sym_allow_other_keys.raw_()) {
             valid_key_p = true; // aok is always valid.
             T_sp value((gctools::Tagged)(lcc_args[arg_index]));
-            if (!seen_aokp) aokp = value.notnilp();
+            aokp = value.notnilp();
           }
           for (size_t key_id = 0; key_id < key_count; ++key_id) {
             T_O* ckey = literals[key_id + key_literal_start];
@@ -512,16 +516,15 @@ static gctools::return_type bytecode_vm(VirtualMachine& vm,
               break;
             }
           }
-          if (!valid_key_p) {
-            if (!unknown_key_p) unknown_key = key;
-            unknown_key_p = true;
+          if (!valid_key_p & !ll_aokp) {
+            T_sp tunknown((gctools::Tagged)(lcc_args[arg_index - 1]));
+            unknown_keys = Cons_O::create(tunknown, unknown_keys);
           }
         }
       }
-      if (unknown_key_p && !aokp && !ll_aokp) {
+      if (unknown_keys.notnilp() && !aokp) {
         T_sp tclosure((gctools::Tagged)gctools::tag_general(closure));
-        T_sp tunknown((gctools::Tagged)unknown_key);
-        throwUnrecognizedKeywordArgumentError(tclosure, tunknown);
+        throwUnrecognizedKeywordArgumentError(tclosure, unknown_keys);
       }
       pc++;
       break;
@@ -1081,14 +1084,15 @@ static unsigned char *long_dispatch(VirtualMachine& vm,
            more_start, key_count_info, key_literal_start, key_frame_start);
     uint16_t key_count = key_count_info & 0x7fff;
     bool ll_aokp = key_count_info & 0x8000;
-    bool seen_aokp = false;
     bool aokp = false;
-    bool unknown_key_p = false;
-    T_O* unknown_key = unbound<T_O>().raw_();
+    T_sp unknown_keys = nil<T_O>();
       // Set keyword arguments to unbound.
     vm.fillreg(fp, unbound<T_O>().raw_(), key_count, key_frame_start);
     if (lcc_nargs > more_start) {
-      // FIXME: Check for odd keyword portion
+      if (((lcc_nargs - more_start) % 2) != 0) {
+        T_sp tclosure((gctools::Tagged)gctools::tag_general(closure));
+        throwOddKeywordsError(tclosure);
+      }
       // KLUDGE: We use a signed type so that if more_start is zero we don't
       // wrap arg_index around. There's probably a cleverer solution.
       ptrdiff_t arg_index;
@@ -1099,7 +1103,7 @@ static unsigned char *long_dispatch(VirtualMachine& vm,
         if (key == kw::_sym_allow_other_keys.raw_()) {
           valid_key_p = true; // aok is always valid.
           T_sp value((gctools::Tagged)(lcc_args[arg_index]));
-          if (!seen_aokp) aokp = value.notnilp();
+          aokp = value.notnilp();
         }
         for (size_t key_id = 0; key_id < key_count; ++key_id) {
           T_O* ckey = literals[key_id + key_literal_start];
@@ -1109,16 +1113,15 @@ static unsigned char *long_dispatch(VirtualMachine& vm,
             break;
           }
         }
-        if (!valid_key_p) {
-          if (!unknown_key_p) unknown_key = key;
-          unknown_key_p = true;
+        if (!valid_key_p && !ll_aokp) {
+          T_sp tunknown((gctools::Tagged)key);
+          unknown_keys = Cons_O::create(tunknown, unknown_keys);
         }
       }
     }
-    if (unknown_key_p && !aokp && !ll_aokp) {
+    if (unknown_keys.notnilp() && !aokp) {
       T_sp tclosure((gctools::Tagged)gctools::tag_general(closure));
-      T_sp tunknown((gctools::Tagged)unknown_key);
-      throwUnrecognizedKeywordArgumentError(tclosure, tunknown);
+      throwUnrecognizedKeywordArgumentError(tclosure, unknown_keys);
     }
     pc += 9;
   }
diff --git a/src/core/corePackage.cc b/src/core/corePackage.cc
@@ -592,6 +592,7 @@ SYMBOL_EXPORT_SC_(KeywordPkg, print);
 SYMBOL_EXPORT_SC_(KeywordPkg, pathname);
 SYMBOL_SC_(CorePkg, setThrowPosition);
 SYMBOL_EXPORT_SC_(CorePkg, wrongNumberOfArguments);
+SYMBOL_EXPORT_SC_(CorePkg, oddKeywords);
 SYMBOL_EXPORT_SC_(KeywordPkg, object);
 SYMBOL_EXPORT_SC_(KeywordPkg, format_control);
 SYMBOL_EXPORT_SC_(KeywordPkg, format_arguments);
diff --git a/src/core/exceptions.cc b/src/core/exceptions.cc
@@ -94,9 +94,14 @@ void throwTooManyArgumentsError(core::T_sp closure, size_t given, size_t require
                              kw::_sym_maxNargs, make_fixnum(required)));
 }
 
-void throwUnrecognizedKeywordArgumentError(core::T_sp closure, T_sp kw) {
+void throwOddKeywordsError(core::T_sp closure) {
+  lisp_error(core::_sym_oddKeywords,
+             lisp_createList(kw::_sym_called_function, closure));
+}
+
+void throwUnrecognizedKeywordArgumentError(core::T_sp closure, core::T_sp kws) {
   lisp_error(core::_sym_unrecognizedKeywordArgumentError,
-             lisp_createList(kw::_sym_unrecognizedKeyword, kw,
+             lisp_createList(kw::_sym_unrecognizedKeywords, kws,
                              kw::_sym_called_function,closure));
 }
 
diff --git a/src/core/lambdaListHandler.cc b/src/core/lambdaListHandler.cc
@@ -45,7 +45,7 @@ SYMBOL_EXPORT_SC_(KeywordPkg, calledFunction);
 SYMBOL_EXPORT_SC_(KeywordPkg, givenNargs);
 SYMBOL_EXPORT_SC_(KeywordPkg, minNargs);
 SYMBOL_EXPORT_SC_(KeywordPkg, maxNargs);
-SYMBOL_EXPORT_SC_(KeywordPkg, unrecognizedKeyword);
+SYMBOL_EXPORT_SC_(KeywordPkg, unrecognizedKeywords);
 SYMBOL_EXPORT_SC_(CorePkg, AMPva_rest );
 /*! Return true if the form represents a type
 */
diff --git a/src/lisp/kernel/clos/conditions.lisp b/src/lisp/kernel/clos/conditions.lisp
@@ -1122,12 +1122,19 @@ The conflict resolver must be one of ~s" chosen-symbol candidates))
                              ((:too-few) "Too few arguments"))
                            (arguments condition) (lambda-list condition)))))))
 
+(define-condition core:odd-keywords (program-error)
+  ((%called-function :initarg :called-function :reader called-function))
+  (:report (lambda (condition stream)
+             (format stream "Odd number of keyword arguments~:[~; for ~s~]."
+                     (called-function condition)
+                     (core:function-name (called-function condition))))))
+
 (define-condition core:unrecognized-keyword-argument-error (program-error)
   ((called-function :initarg :called-function :reader called-function :initform nil)
-   (unrecognized-keyword :initarg :unrecognized-keyword :reader unrecognized-keyword))
+   (unrecognized-keywords :initarg :unrecognized-keywords :reader unrecognized-keywords))
   (:report (lambda (condition stream)
-             (format stream "Unrecognized keyword argument ~S~:[~; for ~S~]."
-                     (unrecognized-keyword condition)
+             (format stream "Unrecognized keyword arguments ~S~:[~; for ~S~]."
+                     (unrecognized-keywords condition)
                      (called-function condition)
                      (core:function-name (called-function condition))))))
 
diff --git a/src/llvmo/link_intrinsics.cc b/src/llvmo/link_intrinsics.cc
@@ -1210,11 +1210,7 @@ T_O* cc_mvcGatherRest2(T_O** values, size_t nvalues) {
 
 void cc_oddKeywordException(core::T_O* tclosure) {
   core::Function_sp closure((gc::Tagged)tclosure);
-  T_sp functionName = closure->functionName();
-  if (functionName.nilp())
-    SIMPLE_ERROR(("Odd number of keyword arguments"));
-  else
-    SIMPLE_ERROR(("In call to %s with lambda-list %s - got odd number of keyword arguments") , _rep_(functionName) , _rep_(closure->lambdaList()));
+  throwOddKeywordsError(closure);
 }
 
 T_O **cc_multipleValuesArrayAddress()
