From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Tue, 29 Nov 2005 11:10:37 +0000 (+0000)
Subject: 0.9.7.1:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a4640afb239d4de3e348430fd9903fc3a88b9139;p=sbcl.git

0.9.7.1:
	fix bug #391.
---

diff --git a/BUGS b/BUGS
index c7e61d5..4b7bf51 100644
--- a/BUGS
+++ b/BUGS
@@ -2110,11 +2110,4 @@ WORKAROUND:
     The value "P" is not of type CHARACTER.
 
 391:
-  Typed slots with moderately difficult types, combined with
-  subclassing, cause the computation of effective-slot-definitions to
-  go awry.
-    (defclass foo () ((x :type fixnum)))
-    (defclass bar (foo) ((x :type (integer 1 5))))
-  gives an error from SB-PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P.  
-  This is probably because of an inappropriate use of *SUBTYPEP in
-  COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS.
+  (fixed in sbcl-0.9.7.1)
diff --git a/NEWS b/NEWS
index 1f557d4..27c4edf 100644
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,8 @@
 ;;;; -*- coding: utf-8; -*-
+changes in sbcl-0.9.8 relative to sbcl-0.9.7:
+  * fixed bug #391: complicated :TYPE intersections in slot
+    definitions no longer cause an error in PCL internals.
+
 changes in sbcl-0.9.7 relative to sbcl-0.9.6:
   * minor incompatible change: (SETF CLASS-NAME) and (SETF
     GENERIC-FUNCTION-NAME) are no longer generic functions, and
diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index 85dd173..a7533d3 100644
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -1127,9 +1127,14 @@
                 allocp t))
         (setq initargs (append (slot-definition-initargs slotd) initargs))
         (let ((slotd-type (slot-definition-type slotd)))
-          (setq type (cond ((eq type t) slotd-type)
-                           ((*subtypep type slotd-type) type)
-                           (t `(and ,type ,slotd-type)))))))
+          (setq type (cond
+                       ((eq type t) slotd-type)
+                       ;; This pairwise type intersection is perhaps a
+                       ;; little inefficient and inelegant, but it's
+                       ;; unlikely to lie on the critical path.  Shout
+                       ;; if I'm wrong.  -- CSR, 2005-11-24
+                       (t (type-specifier
+                           (specifier-type `(and ,type ,slotd-type)))))))))
     (list :name name
           :initform initform
           :initfunction initfunction
diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 42b2ec0..a037be3 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -1201,4 +1201,12 @@
 (with-test (:name (:ctor :unnamed-after/symbol))
   (assert (raises-error? (ctor-unnamed-literal-class2/symbol))))
 
+;;; classes with slot types shouldn't break if the types don't name
+;;; classes (bug #391)
+(defclass slot-type-superclass () ((slot :type fixnum)))
+(defclass slot-type-subclass (slot-type-superclass)
+  ((slot :type (integer 1 5))))
+(let ((instance (make-instance 'slot-type-subclass)))
+  (setf (slot-value instance 'slot) 3))
+
 ;;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index b91e560..25373fe 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.9.7"
+"0.9.7.1"