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 (file)
--- 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 (file)
--- 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 (file)
--- 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).
 \f
+;;; 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))
+\f
 ;;; 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 (file)
--- 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"