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); print_object (obj, printcharfun, escapeflag);
} }
#define PRINT_CIRCLE_CANDIDATE_P(obj) \ static inline bool
(STRINGP (obj) \ print_circle_candidate_p (Lisp_Object obj)
|| CONSP (obj) \ {
|| (VECTORLIKEP (obj) \ if (CONSP (obj))
&& (VECTORP (obj) || CLOSUREP (obj) \ return true;
|| CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \ else if (STRINGP (obj))
|| HASH_TABLE_P (obj) || FONTP (obj) \ return SCHARS (obj) > 0;
|| RECORDP (obj))) \ else if (SYMBOLP (obj))
|| (! NILP (Vprint_gensym) \ return !NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj);
&& SYMBOLP (obj) \ else if (VECTORLIKEP (obj))
&& !SYMBOL_INTERNED_P (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. */ /* The print preprocess stack, used to traverse data structures. */
@ -1423,12 +1434,12 @@ print_preprocess (Lisp_Object obj)
eassert (!NILP (Vprint_circle)); eassert (!NILP (Vprint_circle));
/* The ppstack may contain HASH_UNUSED_ENTRY_KEY which is an invalid /* The ppstack may contain HASH_UNUSED_ENTRY_KEY which is an invalid
Lisp value. Make sure that our filter stops us from traversing it. */ 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; ptrdiff_t base_sp = ppstack.sp;
for (;;) for (;;)
{ {
if (PRINT_CIRCLE_CANDIDATE_P (obj)) if (print_circle_candidate_p (obj))
{ {
if (!HASH_TABLE_P (Vprint_number_table)) if (!HASH_TABLE_P (Vprint_number_table))
Vprint_number_table = CALLN (Fmake_hash_table, QCtest, Qeq); 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; being_printed[print_depth] = obj;
} }
else if (PRINT_CIRCLE_CANDIDATE_P (obj)) else if (print_circle_candidate_p (obj))
{ {
/* With the print-circle feature. */ /* With the print-circle feature. */
Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); 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]+))\\'" (should (string-match "\\`((a . #[0-9]+) (a . #[0-9]+))\\'"
(print-tests--prin1-to-string x)))) (print-tests--prin1-to-string x))))
(let ((print-circle t)) (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 () (print-tests--deftest print-circle-2 ()
;; Bug#31146. ;; Bug#31146.