Fix missing type checks before specbind

This fixes bugs that crashed Emacs when the Lisp interpreter was fed
bad code.

* src/eval.c (FletX, Flet, internal_lisp_condition_case)
(funcall_lambda): Hoist symbol-with-pos elimination and type checks to a
dominating position for efficiency.  This also plugs at least two typing
holes. (Mea culpa.)
* test/src/eval-tests.el (eval-bad-specbind): New regression test.

(cherry picked from commit e50d597f4508c6ef333c5616a2a924360437ba55)

diff --git a/src/eval.c b/src/eval.c
index 2161ab1e1eaf59882b87890dab8785ebd53829b3..16ece744f427f564977454ffe14a935f496ad3e1 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -1018,8 +1018,8 @@ usage: (let* VARLIST BODY...)  */)
        }
 
       var = maybe_remove_pos_from_symbol (var);
-      if (!NILP (lexenv) && BARE_SYMBOL_P (var)
-         && !XBARE_SYMBOL (var)->u.s.declared_special
+      CHECK_TYPE (BARE_SYMBOL_P (var), Qsymbolp, var);
+      if (!NILP (lexenv) && !XBARE_SYMBOL (var)->u.s.declared_special
          && NILP (Fmemq (var, Vinternal_interpreter_environment)))
        /* Lexically bind VAR by adding it to the interpreter's binding
           alist.  */
@@ -1090,10 +1090,10 @@ usage: (let VARLIST BODY...)  */)
       varlist = XCDR (varlist);
       Lisp_Object var = maybe_remove_pos_from_symbol (SYMBOLP (elt) ? elt
                                                      : Fcar (elt));
+      CHECK_TYPE (BARE_SYMBOL_P (var), Qsymbolp, var);
       tem = temps[argnum];
 
-      if (!NILP (lexenv) && SYMBOLP (var)
-         && !XSYMBOL (var)->u.s.declared_special
+      if (!NILP (lexenv) && !XBARE_SYMBOL (var)->u.s.declared_special
          && NILP (Fmemq (var, Vinternal_interpreter_environment)))
        /* Lexically bind VAR by adding it to the lexenv alist.  */
        lexenv = Fcons (Fcons (var, tem), lexenv);
@@ -1492,7 +1492,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
   ptrdiff_t CACHEABLE clausenb = 0;
 
   var = maybe_remove_pos_from_symbol (var);
-  CHECK_SYMBOL (var);
+  CHECK_TYPE (BARE_SYMBOL_P (var), Qsymbolp, var);
 
   Lisp_Object success_handler = Qnil;
 
@@ -3272,18 +3272,18 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
     {
       maybe_quit ();
 
-      Lisp_Object next = XCAR (syms_left);
-      if (!SYMBOLP (next))
+      Lisp_Object next = maybe_remove_pos_from_symbol (XCAR (syms_left));
+      if (!BARE_SYMBOL_P (next))
        xsignal1 (Qinvalid_function, fun);
 
-      if (EQ (next, Qand_rest))
+      if (BASE_EQ (next, Qand_rest))
         {
           if (rest || previous_rest)
             xsignal1 (Qinvalid_function, fun);
           rest = 1;
          previous_rest = true;
         }
-      else if (EQ (next, Qand_optional))
+      else if (BASE_EQ (next, Qand_optional))
         {
           if (optional || rest || previous_rest)
             xsignal1 (Qinvalid_function, fun);
@@ -3305,12 +3305,12 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Lisp_Object *arg_vector)
            arg = Qnil;
 
          /* Bind the argument.  */
-         if (!NILP (lexenv) && SYMBOLP (next))
+         if (!NILP (lexenv))
            /* Lexically bind NEXT by adding it to the lexenv alist.  */
            lexenv = Fcons (Fcons (next, arg), lexenv);
          else
            /* Dynamically bind NEXT.  */
-           specbind (maybe_remove_pos_from_symbol (next), arg);
+           specbind (next, arg);
          previous_rest = false;
        }
     }

diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index 187dc2f34d53dfaf193c68bad7f10df2ae0abb0d..e1663f489c50d623a4a1be36e8903ae1783a0f9a 100644 (file)
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -362,5 +362,13 @@ expressions works for identifiers starting with period."
             (error err))))
     (should (eq inner-error outer-error))))
 
+(ert-deftest eval-bad-specbind ()
+  (should-error (eval '(let (((a b) 23)) (+ 1 2)) t)
+                :type 'wrong-type-argument)
+  (should-error (eval '(let* (((a b) 23)) (+ 1 2)) t)
+                :type 'wrong-type-argument)
+  (should-error (eval '(condition-case (a b) (+ 1 2) (:success 'ok)))
+                :type 'wrong-type-argument)
+  (should-error (eval '(funcall '(lambda ((a b) 3.15) 84) 5 4))))
 
 ;;; eval-tests.el ends here