# HG changeset patch
# User Aidan Kehoe <kehoea@parhasard.net>
# Date 1200429341 -3600
# Node ID b03b5e362fcff61ac4632834ea16615407c1264b
# Parent  cacc942c0d0ff698ddad402df54e0fed35425b09# Parent  f6c39b2d8b6227405501091559be63ca54161c31
Automated merge with file:/Sources/xemacs-21.5-checked-out

diff -r f6c39b2d8b62 -r b03b5e362fcf src/ChangeLog
--- a/src/ChangeLog	Mon Jan 14 16:50:32 2008 -0700
+++ b/src/ChangeLog	Tue Jan 15 21:35:41 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): 
diff -r f6c39b2d8b62 -r b03b5e362fcf src/doprnt.c
--- a/src/doprnt.c	Mon Jan 14 16:50:32 2008 -0700
+++ b/src/doprnt.c	Tue Jan 15 21:35:41 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);
diff -r f6c39b2d8b62 -r b03b5e362fcf src/lisp.h
--- a/src/lisp.h	Mon Jan 14 16:50:32 2008 -0700
+++ b/src/lisp.h	Tue Jan 15 21:35:41 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);
diff -r f6c39b2d8b62 -r b03b5e362fcf src/print.c
--- a/src/print.c	Mon Jan 14 16:50:32 2008 -0700
+++ b/src/print.c	Tue Jan 15 21:35:41 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;
 }
 
diff -r f6c39b2d8b62 -r b03b5e362fcf tests/ChangeLog
--- a/tests/ChangeLog	Mon Jan 14 16:50:32 2008 -0700
+++ b/tests/ChangeLog	Tue Jan 15 21:35:41 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
diff -r f6c39b2d8b62 -r b03b5e362fcf tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el	Mon Jan 14 16:50:32 2008 -0700
+++ b/tests/automated/lisp-tests.el	Tue Jan 15 21:35:41 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)))))