From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 10 Apr 2011 09:21:46 +0000 (+0000)
Subject: 1.0.47.19: another MAKE-INSTANCE regression from 1.0.45.18
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=4ce92c253dbf6a5275ef3cafc193add284bc9795;p=sbcl.git

1.0.47.19: another MAKE-INSTANCE regression from 1.0.45.18

  ...which was masked by another regression till 1.0.46.15.

  Inverted conditional: (SLOT-BOUNDP-USING-CLASS ...) where it should
  have been (NOT (SLOT-BOUNDP-USING-CLASS ...)).

  Reported by Pascal Costanza on sbcl-devel.
---

diff --git a/NEWS b/NEWS
index 7ccf2ef..26baf55 100644
--- a/NEWS
+++ b/NEWS
@@ -16,6 +16,8 @@ changes relative to sbcl-1.0.47:
   * bug fix: forms such as (FUNCALL (FUNCTION NAME OOPS) ...) were compiled
     without complaints.
   * bug fix: less verbose source forms for functions from EVAL. (lp#747485)
+  * bug fix: sense of SLOT-BOUNDP-USING-CLASS was inverted in a MAKE-INSTANCE
+    optimization. (regression from 1.0.45.18/1.0.46.15)
 
 changes in sbcl-1.0.47 relative to sbcl-1.0.46:
   * bug fix: fix mach port rights leaks in mach exception handling code on
diff --git a/src/pcl/ctor.lisp b/src/pcl/ctor.lisp
index 4237d1c..f73b658 100644
--- a/src/pcl/ctor.lisp
+++ b/src/pcl/ctor.lisp
@@ -870,8 +870,8 @@
                                             ,value-form))))
                              (not-boundp-form ()
                                (if (member slotd sbuc-slots :test #'eq)
-                                   `(slot-boundp-using-class
-                                     ,class .instance. ,slotd)
+                                   `(not (slot-boundp-using-class
+                                          ,class .instance. ,slotd))
                                    `(eq (clos-slots-ref .slots. ,i)
                                         +slot-unbound+))))
                         (ecase kind
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 51068be..41b122e 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3600,7 +3600,7 @@
   ;; Test that compile-times don't explode when quoted constants
   ;; get big.
   (labels ((time-n (n)
-             (gc :full t) ; Let's not confuse the issue with GC            
+             (gc :full t) ; Let's not confuse the issue with GC
              (let* ((tree (make-tree (expt 10 n) nil))
                     (t0 (get-internal-run-time))
                     (f (compile nil `(lambda (x) (eq x (quote ,tree)))))
diff --git a/tests/mop.impure.lisp b/tests/mop.impure.lisp
index 35118d0..0f3b115 100644
--- a/tests/mop.impure.lisp
+++ b/tests/mop.impure.lisp
@@ -554,5 +554,30 @@
 (with-test (:name :slow-method-is-fboundp)
   (assert (fboundp '(sb-pcl::slow-method wrapped (cons))))
   (assert (eq :default (funcall #'(sb-pcl::slow-method wrapped (cons)) (list (cons t t)) nil))))
+
+;;; Check that SLOT-BOUNDP-USING-CLASS doesn't confuse MAKE-INSTANCE
+;;; optimizations.
+(defclass sbuc-mio-test-class (standard-class)
+  ())
+(defmethod validate-superclass ((class sbuc-mio-test-class)
+                                (superclass standard-class))
+  t)
+(defvar *sbuc-counter* 0)
+(defmethod slot-boundp-using-class ((class sbuc-mio-test-class)
+                                    (object t)
+                                    (slot standard-effective-slot-definition))
+  (incf *sbuc-counter*)
+  (call-next-method))
+(defclass sbuc-mio-test-object ()
+  ((slot :initform 5 :accessor a-slot))
+  (:metaclass sbuc-mio-test-class))
+(with-test (:name :sbuc-mio-test)
+  (assert (= 5 (funcall
+                (compile
+                 nil
+                 `(lambda ()
+                    (let ((object (make-instance 'sbuc-mio-test-object)))
+                      (slot-value object 'slot)))))))
+  (assert (= 1 *sbuc-counter*)))
 
 ;;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index a2ad1f8..3d95583 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,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".)
-"1.0.47.18"
+"1.0.47.19"