emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

emacs-30 e50d597f450: Fix missing type checks before specbind


From: Mattias Engdegård
Subject: emacs-30 e50d597f450: Fix missing type checks before specbind
Date: Sat, 3 Aug 2024 13:35:22 -0400 (EDT)

branch: emacs-30
commit e50d597f4508c6ef333c5616a2a924360437ba55
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    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.
---
 src/eval.c             | 22 +++++++++++-----------
 test/src/eval-tests.el |  8 ++++++++
 2 files changed, 19 insertions(+), 11 deletions(-)

diff --git a/src/eval.c b/src/eval.c
index 1e0628b4aa3..3681641950c 100644
--- 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;
 
@@ -3280,18 +3280,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);
@@ -3313,12 +3313,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 187dc2f34d5..e1663f489c5 100644
--- 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]