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