mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00
Code Issues Projects Releases Wiki Activity

Don't emit print-circle refs for empty string and vector

Browse source 
The empty vector and string(s) are immutable, contain no references and
always read as the same objects.

* src/print.c (PRINT_CIRCLE_CANDIDATE_P): Turn macro into...
(print_circle_candidate_p): ...a function, and exclude [] and "".
* test/src/print-tests.el (print-circle): Add test case.
This commit is contained in:
Mattias Engdegård 2025-12-04 12:58:34 +01:00
parent 2d682ca13f
commit 5e7a71d0f4
2 changed files with 29 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

39
src/print.c
View file

@ -1325,17 +1325,28 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
print_object (obj, printcharfun, escapeflag);
}
#define PRINT_CIRCLE_CANDIDATE_P(obj) \
(STRINGP (obj) \
|| CONSP (obj) \
|| (VECTORLIKEP (obj) \
&& (VECTORP (obj) || CLOSUREP (obj) \
|| CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \
|| HASH_TABLE_P (obj) || FONTP (obj) \
|| RECORDP (obj))) \
|| (! NILP (Vprint_gensym) \
&& SYMBOLP (obj) \
&& !SYMBOL_INTERNED_P (obj)))
static inline bool
print_circle_candidate_p (Lisp_Object obj)
{
if (CONSP (obj))
return true;
else if (STRINGP (obj))
return SCHARS (obj) > 0;
else if (SYMBOLP (obj))
return !NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj);
else if (VECTORLIKEP (obj))
{
if (VECTORP (obj))
return ASIZE (obj) > 0;
else
return (CLOSUREP (obj)
|| CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
|| HASH_TABLE_P (obj) || FONTP (obj)
|| RECORDP (obj));
}
else
return false;
}
/* The print preprocess stack, used to traverse data structures. */
@ -1423,12 +1434,12 @@ print_preprocess (Lisp_Object obj)
eassert (!NILP (Vprint_circle));
/* The ppstack may contain HASH_UNUSED_ENTRY_KEY which is an invalid
Lisp value. Make sure that our filter stops us from traversing it. */
eassert (!PRINT_CIRCLE_CANDIDATE_P (HASH_UNUSED_ENTRY_KEY));
eassert (!print_circle_candidate_p (HASH_UNUSED_ENTRY_KEY));
ptrdiff_t base_sp = ppstack.sp;
for (;;)
{
if (PRINT_CIRCLE_CANDIDATE_P (obj))
if (print_circle_candidate_p (obj))
{
if (!HASH_TABLE_P (Vprint_number_table))
Vprint_number_table = CALLN (Fmake_hash_table, QCtest, Qeq);
@ -2286,7 +2297,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
}
being_printed[print_depth] = obj;
}
else if (PRINT_CIRCLE_CANDIDATE_P (obj))
else if (print_circle_candidate_p (obj))
{
/* With the print-circle feature. */
Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);

5
test/src/print-tests.el
View file

@ -342,7 +342,10 @@ otherwise, use a different charset."
(should (string-match "\\`((a . #[0-9]+) (a . #[0-9]+))\\'"
(print-tests--prin1-to-string x))))
(let ((print-circle t))
(should (equal "(#1=(a . #1#) #1#)" (print-tests--prin1-to-string x))))))
(should (equal "(#1=(a . #1#) #1#)" (print-tests--prin1-to-string x)))))
(let ((print-circle t))
(should (equal (print-tests--prin1-to-string '([] "" [] ""))
"([] \"\" [] \"\")"))))
(print-tests--deftest print-circle-2 ()
;; Bug#31146.