changeset: 4408:cacc942c0d0ff698ddad402df54e0fed35425b09 parent: 4405:cbf129b005dff4258c4651fefb80e646940d82f7 user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Tue Jan 15 21:35:01 2008 +0100 files: src/ChangeLog src/doprnt.c src/lisp.h src/print.c tests/ChangeLog tests/automated/lisp-tests.el description: Avoid clearing print-gensym-alist inappropriately when printing hash tables. 2008-01-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/lisp-tests.el (thing): Check that printing a hash table literal doesn't clear print-gensym-alist. 2008-01-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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. diff -r cbf129b005dff4258c4651fefb80e646940d82f7 -r cacc942c0d0ff698ddad402df54e0fed35425b09 src/ChangeLog --- 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-12 Aidan Kehoe <kehoea＠parhasa +2008-01-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * rangetab.c (Fmap_range_table): diff -r cbf129b005dff4258c4651fefb80e646940d82f7 -r cacc942c0d0ff698ddad402df54e0fed35425b09 src/doprnt.c --- 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 ＠＠ emacs_doprnt_1 (Lisp_Object stream, cons { /* 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 ＠＠ emacs_doprnt_1 (Lisp_Object stream, cons 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); diff -r cbf129b005dff4258c4651fefb80e646940d82f7 -r cacc942c0d0ff698ddad402df54e0fed35425b09 src/lisp.h --- 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 (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); diff -r cbf129b005dff4258c4651fefb80e646940d82f7 -r cacc942c0d0ff698ddad402df54e0fed35425b09 src/print.c --- 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 ＠＠ Output stream is STREAM, or value of `st 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 ＠＠ second argument NOESCAPE is non-nil. { /* 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; } diff -r cbf129b005dff4258c4651fefb80e646940d82f7 -r cacc942c0d0ff698ddad402df54e0fed35425b09 tests/ChangeLog --- 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-03 Stephen J. Turnbull <stephe +2008-01-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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(a)xemacs.org&gt; * automated/symbol-tests.el (Symbol documentation): Add tests to diff -r cbf129b005dff4258c4651fefb80e646940d82f7 -r cacc942c0d0ff698ddad402df54e0fed35425b09 tests/automated/lisp-tests.el --- 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))))) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches