From 0d97bc11779b76725b1a47d0815d4b0d6203091e Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Fri, 2 May 2003 12:43:06 +0000
Subject: [PATCH] 	Test case SHARED-INITIALIZE.5.1 from Paul Dietz. 
 SHARED-INITIALIZE being specified to initialize slots that are 
 unbound, including class slots.

	* src/pcl/init.lisp (shared-initialize): Initialize class
	slots that are unbound.
---
 pcl/init.lisp | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/pcl/init.lisp b/pcl/init.lisp
index 73598d4f2..e4848421e 100644
--- a/pcl/init.lisp
+++ b/pcl/init.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/init.lisp,v 1.19 2003/04/23 17:38:59 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/init.lisp,v 1.20 2003/05/02 12:43:06 gerd Exp $")
 
 ;;;
 ;;; This file defines the initialization and related protocols.
@@ -164,11 +164,13 @@
 	      (loop for slotd in (class-slots class)
 		    unless (initialize-slot-from-initarg class instance slotd)
 		    collect slotd)))
-	(loop for slotd in initfn-slotds
-	      when (and (not (eq :class (slot-definition-allocation slotd)))
-			(or (eq t slot-names)
-			    (memq (slot-definition-name slotd) slot-names))) do
-	      (initialize-slot-from-initfunction class instance slotd)))
+	(dolist (slotd initfn-slotds)
+	  (if (eq (slot-definition-allocation slotd) :class)
+	      (unless (slot-boundp-using-class class instance slotd)
+		(initialize-slot-from-initfunction class instance slotd))
+	      (when (or (eq t slot-names)
+			(memq (slot-definition-name slotd) slot-names))
+		(initialize-slot-from-initfunction class instance slotd)))))
       instance)))
 
 
-- 
GitLab