From a9047da0262d0c2f617fb6b6609293526fc479db Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 3 Aug 2024 19:08:39 +0200 Subject: [PATCH] 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) --- 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 2161ab1e1ea..16ece744f42 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; @@ -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 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 -- 2.39.2