[Sbcl-commits] CVS: sbcl/src/code print.lisp,1.79,1.80

[Gabor M. <me...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv17833/src/code

Modified Files:
	print.lisp 
Log Message:
1.0.40.1: fix return value of WRITE

Used to return NIL when the compiler macro for the constant keyword
argument case triggered.

Add test.


Index: print.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/print.lisp,v
retrieving revision 1.79
retrieving revision 1.80
diff -u -d -r1.79 -r1.80
--- print.lisp	27 Apr 2010 09:07:59 -0000	1.79
+++ print.lisp	16 Jul 2010 07:42:23 -0000	1.80
@@ -193,9 +193,11 @@
         (push (list variable value) bind)))
     (unless (assoc 'stream bind)
       (push (list 'stream '*standard-output*) bind))
-    `(let ,(nreverse bind)
-       ,@(when ignore `((declare (ignore ,@ignore))))
-       (output-object ,object stream))))
+    (once-only ((object object))
+      `(let ,(nreverse bind)
+         ,@(when ignore `((declare (ignore ,@ignore))))
+         (output-object ,object stream)
+         ,object))))
 
 (defun prin1 (object &optional stream)
   #!+sb-doc