procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix reader infinite recursion for circular mixed-type values

Browse source 
Make sure that the value added to the `read_objects_completed` set is
the one we actually return; previously this wasn't the case for conses
because of an optimisation (bug#54501).

Also add a check for vacuous self-references such as #1=#1# instead of
returning a nonsense value from thin air.

* src/lread.c (read1): Treat numbered conses correctly as described
above.  Detect vacuous self-references.
* test/src/lread-tests.el (lread-test-read-and-print)
(lread-test-circle-cases, lread-circle): Add tests.
This commit is contained in:
Mattias Engdegård 2022-03-26 16:44:18 +01:00
parent e96061de95
commit 2dfeea8962
2 changed files with 52 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
src/lread.c
View file

@ -3488,6 +3488,29 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms)
/* Read the object itself. */
Lisp_Object tem = read0 (readcharfun, locate_syms);
if (CONSP (tem))
{
if (BASE_EQ (tem, placeholder))
/* Catch silly games like #1=#1# */
invalid_syntax ("nonsensical self-reference",
readcharfun);
/* Optimisation: since the placeholder is already
a cons, repurpose it as the actual value.
This allows us to skip the substition below,
since the placeholder is already referenced
inside TEM at the appropriate places. */
Fsetcar (placeholder, XCAR (tem));
Fsetcdr (placeholder, XCDR (tem));
struct Lisp_Hash_Table *h2
= XHASH_TABLE (read_objects_completed);
ptrdiff_t i = hash_lookup (h2, placeholder, &hash);
eassert (i < 0);
hash_put (h2, placeholder, Qnil, hash);
return placeholder;
}
/* If it can be recursive, remember it for
future substitutions. */
if (! SYMBOLP (tem)
@ -3502,24 +3525,15 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms)
}
/* Now put it everywhere the placeholder was... */
if (CONSP (tem))
{
Fsetcar (placeholder, XCAR (tem));
Fsetcdr (placeholder, XCDR (tem));
return placeholder;
}
else
{
Flread__substitute_object_in_subtree
(tem, placeholder, read_objects_completed);
Flread__substitute_object_in_subtree
(tem, placeholder, read_objects_completed);
/* ...and #n# will use the real value from now on. */
i = hash_lookup (h, number, &hash);
eassert (i >= 0);
set_hash_value_slot (h, i, tem);
/* ...and #n# will use the real value from now on. */
i = hash_lookup (h, number, &hash);
eassert (i >= 0);
set_hash_value_slot (h, i, tem);
return tem;
}
return tem;
}
/* #n# returns a previously read object. */

22
test/src/lread-tests.el
View file

@ -258,5 +258,27 @@ literals (Bug#20852)."
(should (equal (read "-0.e-5") -0.0))
)
(defun lread-test-read-and-print (str)
(let* ((read-circle t)
(print-circle t)
(val (read-from-string str)))
(if (consp val)
(prin1-to-string (car val))
(error "reading %S failed: %S" str val))))
(defconst lread-test-circle-cases
'("#1=(#1# . #1#)"
"#1=[#1# a #1#]"
"#1=(#2=[#1# #2#] . #1#)"
"#1=(#2=[#1# #2#] . #2#)"
"#1=[#2=(#1# . #2#)]"
"#1=(#2=[#3=(#1# . #2#) #4=(#3# . #4#)])"
))
(ert-deftest lread-circle ()
(dolist (str lread-test-circle-cases)
(ert-info (str :prefix "input: ")
(should (equal (lread-test-read-and-print str) str))))
(should-error (read-from-string "#1=#1#") :type 'invalid-read-syntax))
;;; lread-tests.el ends here