12:25 a.m.
changeset: 4408:cacc942c0d0ff698ddad402df54e0fed35425b09
parent: 4405:cbf129b005dff4258c4651fefb80e646940d82f7
user: Aidan Kehoe <kehoea(a)parhasard.net>
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>
* 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>
* 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>
+
+ * 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>
* 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>
+
+ * 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>
* 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