[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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- emacs-30 e50d597f450: Fix missing type checks before specbind,
Mattias Engdegård <=