From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Tue, 22 Apr 2003 15:10:57 +0000 (+0000)
Subject: 0.pre8.91:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=394ea85ef47f8b145437e1498266487c4f96f285;p=sbcl.git

0.pre8.91:
	Fix for ctor MAKE-INSTANCE optimization
	... don't overzealously assert that a given location is unset;
		users can supply duplicate initargs.
---

diff --git a/NEWS b/NEWS
index 5b88b78..7838b2e 100644
--- a/NEWS
+++ b/NEWS
@@ -1691,6 +1691,8 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
     ** ENDP in safe mode checks its argument to be of type LIST;
     ** COPY-SYMBOL in a threaded build no longer fails when the symbol
        in question is unbound;
+    ** optimized MAKE-INSTANCE functions no longer cause internal
+       assertion failures in the presence of duplicate initargs;
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles
diff --git a/src/pcl/ctor.lisp b/src/pcl/ctor.lisp
index df5e2dc..bd178c2 100644
--- a/src/pcl/ctor.lisp
+++ b/src/pcl/ctor.lisp
@@ -373,7 +373,7 @@
     (multiple-value-bind (si-around si-before si-primary si-after)
 	(standard-sort-methods si-methods)
       (declare (ignore si-primary))
-      (assert (and (null ii-around) (null si-around)))
+      (aver (and (null ii-around) (null si-around)))
       (let ((initargs (ctor-initargs ctor))
 	    (slot-inits (slot-init-forms ctor (or ii-before si-before))))
 	(values
@@ -437,14 +437,14 @@
 	       (cdr (assoc initarg initarg-locations :test #'eq)))
 
 	     (class-init (location type val)
-	       (assert (consp location))
+	       (aver (consp location))
 	       (unless (assoc location class-inits :test #'eq)
 		 (push (list location type val) class-inits)))
 
 	     (instance-init (location type val)
-	       (assert (integerp location))
-	       (assert (not (instance-slot-initialized-p location)))
-	       (setf (aref slot-vector location) (list type val)))
+	       (aver (integerp location))
+	       (unless (instance-slot-initialized-p location)
+		 (setf (aref slot-vector location) (list type val))))
 
 	     (instance-slot-initialized-p (location)
 	       (not (null (aref slot-vector location)))))
diff --git a/tests/clos.impure-cload.lisp b/tests/clos.impure-cload.lisp
index db4785a..f0a1829 100644
--- a/tests/clos.impure-cload.lisp
+++ b/tests/clos.impure-cload.lisp
@@ -70,5 +70,15 @@
 ;;; (we can't call it without defining methods on allocate-instance
 ;;; etc., but we should be able to define it).
 
+;;; the ctor MAKE-INSTANCE optimizer used not to handle duplicate
+;;; initargs.
+(defclass dinitargs-class1 ()
+  ((a :initarg :a)))
+(assert (= (slot-value (make-instance 'dinitargs-class1 :a 1 :a 2) 'a) 1))
+
+(defclass dinitargs-class2 ()
+  ((b :initarg :b1 :initarg :b2)))
+(assert (= (slot-value (make-instance 'dinitargs-class2 :b2 3 :b1 4) 'b) 3))
+
 ;;; success
 (sb-ext:quit :unix-status 104)
\ No newline at end of file
diff --git a/version.lisp-expr b/version.lisp-expr
index 27dcc26..0369f62 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre8.90"
+"0.pre8.91"