changeset 4:591eb9a4d1b0

don't upcase slot-names, check for unbound slots
author John Leuner <jewel@subvert-the-dominant-paradigm.net>
date Mon, 19 May 2008 03:48:38 +0530
parents 2f1ffb95faf0
children 10bb32fe1122
files lisp/slurp.lisp
diffstat 1 files changed, 4 insertions(+), 3 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/slurp.lisp	Mon May 05 19:30:01 2008 +0530
+++ b/lisp/slurp.lisp	Mon May 19 03:48:38 2008 +0530
@@ -179,8 +179,9 @@
 	       (slots (sb-pcl:class-slots class)))
 	  (setf (gethash object recursion-set) object)
 	  (loop for s in slots do (let ((name (sb-pcl:slot-definition-name s)))
-				    (setf (slot-value object name) 
-					  (discard-placeholders (slot-value object name) recursion-set))))
+				    (when (slot-boundp object name)
+				      (setf (slot-value object name) 
+					    (discard-placeholders (slot-value object name) recursion-set)))))
 	  object))))
 
 (defun make-state-descriptor (class)
@@ -255,7 +256,7 @@
 ;    (break placeholder newobject state-descriptor)
     (when (has-named-slots state-descriptor) 					; read the slots
       (loop for slot in (named-slots state-descriptor) do
-	    (let ((slot-name (intern (string-upcase slot) package))
+	    (let ((slot-name (intern slot package))
 		  (value (read-object *reader*)))
 	      (handler-case
 		  (setf (slot-value newobject slot-name) (modify-decoded-slot newobject slot-name value))