[Sbcl-commits] CVS: sbcl/src/code reader.lisp,1.52,1.53

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv3397/src/code

Modified Files:
	reader.lisp 
Log Message:
1.0.23.18: SET-[DISPATCH-]MACRO-CHARACTER fixes

 * Patch by Tobias Ritterweiler, plus tests and making S-D-M-C return T.


Index: reader.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/reader.lisp,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -d -r1.52 -r1.53
--- reader.lisp	8 Jul 2008 21:31:53 -0000	1.52
+++ reader.lisp	4 Dec 2008 16:50:15 -0000	1.53
@@ -97,13 +97,11 @@
         #'read-token)))
 
 (defun set-cmt-entry (char new-value-designator &optional (rt *readtable*))
-  (if (typep char 'base-char)
-      (setf (svref (character-macro-array rt) (char-code char))
-            (and new-value-designator
-                 (%coerce-callable-to-fun new-value-designator)))
-      (setf (gethash char (character-macro-hash-table rt))
-        (and new-value-designator
-                 (%coerce-callable-to-fun new-value-designator)))))
+  (let ((new (when new-value-designator
+               (%coerce-callable-to-fun new-value-designator))))
+    (if (typep char 'base-char)
+        (setf (svref (character-macro-array rt) (char-code char)) new)
+        (setf (gethash char (character-macro-hash-table rt)) new))))
 
 (defun undefined-macro-char (stream char)
   (unless *read-suppress*
@@ -1470,7 +1468,8 @@
                       :test #'char= :key #'car)))
     (if dpair
         (setf (gethash sub-char (cdr dpair)) (coerce function 'function))
-        (error "~S is not a dispatch char." disp-char))))
+        (error "~S is not a dispatch char." disp-char))
+    t))
 
 (defun get-dispatch-macro-character (disp-char sub-char
                                      &optional (rt *readtable*))