Mercurial > hg > xemacs-beta
changeset 4394:cacc942c0d0f
Avoid clearing print-gensym-alist inappropriately when printing hash tables.
2008-01-15 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el (thing):
Check that printing a hash table literal doesn't clear
print-gensym-alist.
2008-01-15 Aidan Kehoe <kehoea@parhasard.net>
* print.c (prin1_to_string): New.
The guts of Fprin1_to_string, without resetting
Vprint_gensym_alist.
(Fprin1_to_string):
Call prin1_to_string, wrapped with RESET_PRINT_GENSYM calls.
* doprnt.c (emacs_doprnt_1):
Call prin1_to_string, not Fprin1_to_string (dos veces). Avoids an
inappropriate reset of print-gensym-alist.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 15 Jan 2008 21:35:01 +0100 |
| parents | cbf129b005df |
| children | b03b5e362fcf |
| files | src/ChangeLog src/doprnt.c src/lisp.h src/print.c tests/ChangeLog tests/automated/lisp-tests.el |
| diffstat | 6 files changed, 56 insertions(+), 13 deletions(-) [+] |
line wrap: on
line diff
--- a/src/ChangeLog Sat Jan 12 18:04:13 2008 +0100 +++ b/src/ChangeLog Tue Jan 15 21:35:01 2008 +0100 @@ -1,3 +1,14 @@ +2008-01-15 Aidan Kehoe <kehoea@parhasard.net> + + * print.c (prin1_to_string): New. + The guts of Fprin1_to_string, without resetting + Vprint_gensym_alist. + (Fprin1_to_string): + Call prin1_to_string, wrapped with RESET_PRINT_GENSYM calls. + * doprnt.c (emacs_doprnt_1): + Call prin1_to_string, not Fprin1_to_string (dos veces). Avoids an + inappropriate reset of print-gensym-alist. + 2008-01-12 Aidan Kehoe <kehoea@parhasard.net> * rangetab.c (Fmap_range_table):
--- a/src/doprnt.c Sat Jan 12 18:04:13 2008 +0100 +++ b/src/doprnt.c Tue Jan 15 21:35:01 2008 +0100 @@ -558,7 +558,7 @@ { /* For `S', prin1 the argument and then treat like a string. */ - ls = Fprin1_to_string (obj, Qnil); + ls = prin1_to_string (obj, 0); } else if (STRINGP (obj)) ls = obj; @@ -567,7 +567,7 @@ else { /* convert to string using princ. */ - ls = Fprin1_to_string (obj, Qt); + ls = prin1_to_string (obj, 1); } string = XSTRING_DATA (ls); string_len = XSTRING_LENGTH (ls);
--- a/src/lisp.h Sat Jan 12 18:04:13 2008 +0100 +++ b/src/lisp.h Tue Jan 15 21:35:01 2008 +0100 @@ -4932,6 +4932,7 @@ EXFUN (Fprinc, 2); EXFUN (Fprint, 2); +Lisp_Object prin1_to_string (Lisp_Object, int); /* Lower-level ways to output data: */ void default_object_printer (Lisp_Object, Lisp_Object, int);
--- a/src/print.c Sat Jan 12 18:04:13 2008 +0100 +++ b/src/print.c Tue Jan 15 21:35:01 2008 +0100 @@ -867,6 +867,26 @@ return object; } +Lisp_Object +prin1_to_string (Lisp_Object object, int noescape) +{ + /* This function can GC */ + Lisp_Object result = Qnil; + Lisp_Object stream = make_resizing_buffer_output_stream (); + Lstream *str = XLSTREAM (stream); + /* gcpro OBJECT in case a caller forgot to do so */ + struct gcpro gcpro1, gcpro2, gcpro3; + GCPRO3 (object, stream, result); + + print_internal (object, stream, !noescape); + Lstream_flush (str); + UNGCPRO; + result = make_string (resizing_buffer_stream_ptr (str), + Lstream_byte_count (str)); + Lstream_delete (str); + return result; +} + DEFUN ("prin1-to-string", Fprin1_to_string, 1, 2, 0, /* Return a string containing the printed representation of OBJECT, any Lisp object. Quoting characters are used when needed to make output @@ -877,20 +897,11 @@ { /* This function can GC */ Lisp_Object result = Qnil; - Lisp_Object stream = make_resizing_buffer_output_stream (); - Lstream *str = XLSTREAM (stream); - /* gcpro OBJECT in case a caller forgot to do so */ - struct gcpro gcpro1, gcpro2, gcpro3; - GCPRO3 (object, stream, result); RESET_PRINT_GENSYM; - print_internal (object, stream, NILP (noescape)); + result = prin1_to_string (object, !(EQ(noescape, Qnil))); RESET_PRINT_GENSYM; - Lstream_flush (str); - UNGCPRO; - result = make_string (resizing_buffer_stream_ptr (str), - Lstream_byte_count (str)); - Lstream_delete (str); + return result; }
--- a/tests/ChangeLog Sat Jan 12 18:04:13 2008 +0100 +++ b/tests/ChangeLog Tue Jan 15 21:35:01 2008 +0100 @@ -1,3 +1,9 @@ +2008-01-15 Aidan Kehoe <kehoea@parhasard.net> + + * automated/lisp-tests.el (thing): + Check that printing a hash table literal doesn't clear + print-gensym-alist. + 2008-01-03 Stephen J. Turnbull <stephen@xemacs.org> * automated/symbol-tests.el (Symbol documentation): Add tests to
--- a/tests/automated/lisp-tests.el Sat Jan 12 18:04:13 2008 +0100 +++ b/tests/automated/lisp-tests.el Tue Jan 15 21:35:01 2008 +0100 @@ -1299,3 +1299,17 @@ ;; Check all-completions ignore element start with space. (Assert (not (all-completions "" '((" hidden" . "object"))))) (Assert (all-completions " " '((" hidden" . "object")))) + +(let* ((literal-with-uninterned + '(first-element + [#1=#:G32976 #2=#:G32974 #3=#:G32971 #4=#:G32969 alias + #s(hash-table size 256 data (969 ?ù 55 ?7 166 ?¦ )) + #5=#:G32970 #6=#:G32972])) + (print-readably t) + (print-gensym t) + (printed-with-uninterned (prin1-to-string literal-with-uninterned)) + (awkward-regexp "#1=#") + (first-match-start (string-match awkward-regexp + printed-with-uninterned))) + (Assert (null (string-match awkward-regexp printed-with-uninterned + (1+ first-match-start)))))