[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 93511e9: Fix some crashes on self-modifying Elisp c
From: |
Paul Eggert |
Subject: |
[Emacs-diffs] master 93511e9: Fix some crashes on self-modifying Elisp code |
Date: |
Sun, 6 Aug 2017 19:58:40 -0400 (EDT) |
branch: master
commit 93511e94735de5862880f5ea9bf12705c1440363
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>
Fix some crashes on self-modifying Elisp code
Prompted by a problem report by Alex in:
http://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00143.html
* src/eval.c (For, Fprogn, Fsetq, FletX, eval_sub):
Compute XCDR (x) near XCAR (x); although this doesn't fix any bugs,
it is likely to run a bit faster with typical hardware caches.
(Fif): Use Fcdr instead of XCDR, to avoid crashing on
self-modifying S-expressions.
(Fsetq, Flet, eval_sub): Count the number of arguments as we go
instead of trusting an Flength prepass, to avoid problems when the
code is self-modifying.
(Fquote, Ffunction, Fdefvar, Fdefconst): Prefer !NILP to CONSP
where either will do. This is mostly to document the fact that
the value must be a proper list. It's also a tiny bit faster on
typical machines nowadays.
(Fdefconst, FletX): Prefer XCAR+XCDR to Fcar+Fcdr when either will do.
(eval_sub): Check that the args are a list as opposed to some
other object that has a length. This prevents e.g. (if . "string")
from making Emacs dump core in some cases.
* test/src/eval-tests.el (eval-tests--if-dot-string)
(eval-tests--let-with-circular-defs, eval-tests--mutating-cond):
New tests.
---
src/eval.c | 128 ++++++++++++++++++++++++++-----------------------
test/src/eval-tests.el | 20 ++++++++
2 files changed, 87 insertions(+), 61 deletions(-)
diff --git a/src/eval.c b/src/eval.c
index e590038..fe2708b 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -354,10 +354,11 @@ usage: (or CONDITIONS...) */)
while (CONSP (args))
{
- val = eval_sub (XCAR (args));
+ Lisp_Object arg = XCAR (args);
+ args = XCDR (args);
+ val = eval_sub (arg);
if (!NILP (val))
break;
- args = XCDR (args);
}
return val;
@@ -374,10 +375,11 @@ usage: (and CONDITIONS...) */)
while (CONSP (args))
{
- val = eval_sub (XCAR (args));
+ Lisp_Object arg = XCAR (args);
+ args = XCDR (args);
+ val = eval_sub (arg);
if (NILP (val))
break;
- args = XCDR (args);
}
return val;
@@ -397,7 +399,7 @@ usage: (if COND THEN ELSE...) */)
if (!NILP (cond))
return eval_sub (Fcar (XCDR (args)));
- return Fprogn (XCDR (XCDR (args)));
+ return Fprogn (Fcdr (XCDR (args)));
}
DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
@@ -439,8 +441,9 @@ usage: (progn BODY...) */)
while (CONSP (body))
{
- val = eval_sub (XCAR (body));
+ Lisp_Object form = XCAR (body);
body = XCDR (body);
+ val = eval_sub (form);
}
return val;
@@ -488,35 +491,26 @@ The return value of the `setq' form is the value of the
last VAL.
usage: (setq [SYM VAL]...) */)
(Lisp_Object args)
{
- Lisp_Object val, sym, lex_binding;
+ Lisp_Object val = args, tail = args;
- val = args;
- if (CONSP (args))
+ for (EMACS_INT nargs = 0; CONSP (tail); nargs += 2)
{
- Lisp_Object args_left = args;
- Lisp_Object numargs = Flength (args);
-
- if (XINT (numargs) & 1)
- xsignal2 (Qwrong_number_of_arguments, Qsetq, numargs);
-
- do
- {
- val = eval_sub (Fcar (XCDR (args_left)));
- sym = XCAR (args_left);
-
- /* Like for eval_sub, we do not check declared_special here since
- it's been done when let-binding. */
- if (!NILP (Vinternal_interpreter_environment) /* Mere optimization!
*/
- && SYMBOLP (sym)
- && !NILP (lex_binding
- = Fassq (sym, Vinternal_interpreter_environment)))
- XSETCDR (lex_binding, val); /* SYM is lexically bound. */
- else
- Fset (sym, val); /* SYM is dynamically bound. */
-
- args_left = Fcdr (XCDR (args_left));
- }
- while (CONSP (args_left));
+ Lisp_Object sym = XCAR (tail), lex_binding;
+ tail = XCDR (tail);
+ if (!CONSP (tail))
+ xsignal2 (Qwrong_number_of_arguments, Qsetq, make_number (nargs + 1));
+ Lisp_Object arg = XCAR (tail);
+ tail = XCDR (tail);
+ val = eval_sub (arg);
+ /* Like for eval_sub, we do not check declared_special here since
+ it's been done when let-binding. */
+ if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
+ && SYMBOLP (sym)
+ && !NILP (lex_binding
+ = Fassq (sym, Vinternal_interpreter_environment)))
+ XSETCDR (lex_binding, val); /* SYM is lexically bound. */
+ else
+ Fset (sym, val); /* SYM is dynamically bound. */
}
return val;
@@ -535,7 +529,7 @@ of unexpected results when a quoted object is modified.
usage: (quote ARG) */)
(Lisp_Object args)
{
- if (CONSP (XCDR (args)))
+ if (!NILP (XCDR (args)))
xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
return XCAR (args);
}
@@ -549,7 +543,7 @@ usage: (function ARG) */)
{
Lisp_Object quoted = XCAR (args);
- if (CONSP (XCDR (args)))
+ if (!NILP (XCDR (args)))
xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
if (!NILP (Vinternal_interpreter_environment)
@@ -734,9 +728,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
sym = XCAR (args);
tail = XCDR (args);
- if (CONSP (tail))
+ if (!NILP (tail))
{
- if (CONSP (XCDR (tail)) && CONSP (XCDR (XCDR (tail))))
+ if (!NILP (XCDR (tail)) && !NILP (XCDR (XCDR (tail))))
error ("Too many arguments");
tem = Fdefault_boundp (sym);
@@ -803,20 +797,24 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
Lisp_Object sym, tem;
sym = XCAR (args);
- if (CONSP (Fcdr (XCDR (XCDR (args)))))
- error ("Too many arguments");
+ Lisp_Object docstring = Qnil;
+ if (!NILP (XCDR (XCDR (args))))
+ {
+ if (!NILP (XCDR (XCDR (XCDR (args)))))
+ error ("Too many arguments");
+ docstring = XCAR (XCDR (XCDR (args)));
+ }
- tem = eval_sub (Fcar (XCDR (args)));
+ tem = eval_sub (XCAR (XCDR (args)));
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fset_default (sym, tem);
XSYMBOL (sym)->declared_special = 1;
- tem = Fcar (XCDR (XCDR (args)));
- if (!NILP (tem))
+ if (!NILP (docstring))
{
if (!NILP (Vpurify_flag))
- tem = Fpurecopy (tem);
- Fput (sym, Qvariable_documentation, tem);
+ docstring = Fpurecopy (docstring);
+ Fput (sym, Qvariable_documentation, docstring);
}
Fput (sym, Qrisky_local_variable, Qt);
LOADHIST_ATTACH (sym);
@@ -844,27 +842,29 @@ Each VALUEFORM can refer to the symbols already bound by
this VARLIST.
usage: (let* VARLIST BODY...) */)
(Lisp_Object args)
{
- Lisp_Object varlist, var, val, elt, lexenv;
+ Lisp_Object var, val, elt, lexenv;
ptrdiff_t count = SPECPDL_INDEX ();
lexenv = Vinternal_interpreter_environment;
- for (varlist = XCAR (args); CONSP (varlist); varlist = XCDR (varlist))
+ Lisp_Object varlist = XCAR (args);
+ while (CONSP (varlist))
{
maybe_quit ();
elt = XCAR (varlist);
+ varlist = XCDR (varlist);
if (SYMBOLP (elt))
{
var = elt;
val = Qnil;
}
- else if (! NILP (Fcdr (Fcdr (elt))))
- signal_error ("`let' bindings can have only one value-form", elt);
else
{
var = Fcar (elt);
- val = eval_sub (Fcar (Fcdr (elt)));
+ if (! NILP (Fcdr (XCDR (elt))))
+ signal_error ("`let' bindings can have only one value-form", elt);
+ val = eval_sub (Fcar (XCDR (elt)));
}
if (!NILP (lexenv) && SYMBOLP (var)
@@ -911,33 +911,37 @@ usage: (let VARLIST BODY...) */)
CHECK_LIST (varlist);
/* Make space to hold the values to give the bound variables. */
- elt = Flength (varlist);
- SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
+ EMACS_INT varlist_len = XFASTINT (Flength (varlist));
+ SAFE_ALLOCA_LISP (temps, varlist_len);
+ ptrdiff_t nvars = varlist_len;
/* Compute the values and store them in `temps'. */
- for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
+ for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++)
{
maybe_quit ();
elt = XCAR (varlist);
+ varlist = XCDR (varlist);
if (SYMBOLP (elt))
- temps [argnum++] = Qnil;
+ temps[argnum] = Qnil;
else if (! NILP (Fcdr (Fcdr (elt))))
signal_error ("`let' bindings can have only one value-form", elt);
else
- temps [argnum++] = eval_sub (Fcar (Fcdr (elt)));
+ temps[argnum] = eval_sub (Fcar (Fcdr (elt)));
}
+ nvars = argnum;
lexenv = Vinternal_interpreter_environment;
varlist = XCAR (args);
- for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
+ for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++)
{
Lisp_Object var;
elt = XCAR (varlist);
+ varlist = XCDR (varlist);
var = SYMBOLP (elt) ? elt : Fcar (elt);
- tem = temps[argnum++];
+ tem = temps[argnum];
if (!NILP (lexenv) && SYMBOLP (var)
&& !XSYMBOL (var)->declared_special
@@ -2135,6 +2139,7 @@ eval_sub (Lisp_Object form)
original_fun = XCAR (form);
original_args = XCDR (form);
+ CHECK_LIST (original_args);
/* This also protects them from gc. */
count = record_in_backtrace (original_fun, &original_args, UNEVALLED);
@@ -2176,15 +2181,16 @@ eval_sub (Lisp_Object form)
SAFE_ALLOCA_LISP (vals, XINT (numargs));
- while (!NILP (args_left))
+ while (CONSP (args_left) && argnum < XINT (numargs))
{
- vals[argnum++] = eval_sub (Fcar (args_left));
- args_left = Fcdr (args_left);
+ Lisp_Object arg = XCAR (args_left);
+ args_left = XCDR (args_left);
+ vals[argnum++] = eval_sub (arg);
}
- set_backtrace_args (specpdl + count, vals, XINT (numargs));
+ set_backtrace_args (specpdl + count, vals, argnum);
- val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
+ val = XSUBR (fun)->function.aMANY (argnum, vals);
check_cons_list ();
lisp_eval_depth--;
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index 03f4087..b98de0a 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -59,4 +59,24 @@ Bug#24912 and Bug#24913."
(should-error (,form ,arg) :type 'wrong-type-argument))
t)))
+(ert-deftest eval-tests--if-dot-string ()
+ "Check that Emacs rejects (if . \"string\")."
+ (should-error (eval '(if . "abc")) :type 'wrong-type-argument)
+ (let ((if-tail (list '(setcdr if-tail "abc") t)))
+ (should-error (eval (cons 'if if-tail))))
+ (let ((if-tail (list '(progn (setcdr if-tail "abc") nil) t)))
+ (should-error (eval (cons 'if if-tail)))))
+
+(ert-deftest eval-tests--let-with-circular-defs ()
+ "Check that Emacs reports an error for (let VARS ...) when VARS is circular."
+ (let ((vars (list 'v)))
+ (setcdr vars vars)
+ (dolist (let-sym '(let let*))
+ (should-error (eval (list let-sym vars))))))
+
+(ert-deftest eval-tests--mutating-cond ()
+ "Check that Emacs doesn't crash on a cond clause that mutates during eval."
+ (let ((clauses (list '((progn (setcdr clauses "ouch") nil)))))
+ (should-error (eval (cons 'cond clauses)))))
+
;;; eval-tests.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 93511e9: Fix some crashes on self-modifying Elisp code,
Paul Eggert <=