From ea4b766a763ce8a2978b937e665a3eb8fd7e5bcb Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Sun, 30 Nov 2003 15:19:34 +0000
Subject: [PATCH] 0.8.6.17: 	Fix for bogus type warning (Rudi sbcl-devel
 2003-09-21) 	... I don't really know what I'm doing here.
  Presumably 		SLOTS could never be NIL at this
 point?  Bah.

---
 src/pcl/vector.lisp    |   20 +++++++++++++++++---
 tests/compiler.test.sh |   21 +++++++++++++++++++++
 version.lisp-expr      |    2 +-
 3 files changed, 39 insertions(+), 4 deletions(-)

diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp
index e6bfa4b..02bbe28 100644
--- a/src/pcl/vector.lisp
+++ b/src/pcl/vector.lisp
@@ -665,8 +665,21 @@
 	`(locally (declare #.*optimize-speed*)
 	  (let ((,index (pvref ,pv ,pv-offset)))
 	    (setq ,value (typecase ,index
+			   ;; FIXME: the line marked by KLUDGE below
+			   ;; (and the analogous spot in
+			   ;; INSTANCE-WRITE-INTERNAL) is there purely
+			   ;; to suppress a type mismatch warning that
+			   ;; propagates through to user code.
+			   ;; Presumably SLOTS at this point can never
+			   ;; actually be NIL, but the compiler seems
+			   ;; to think it could, so we put this here
+			   ;; to shut it up.  (see also mail Rudi
+			   ;; Schlatte sbcl-devel 2003-09-21) -- CSR,
+			   ;; 2003-11-30
 			   ,@(when (or (null type) (eq type :instance))
-			       `((fixnum (clos-slots-ref ,slots ,index))))
+			       `((fixnum
+				  (and ,slots ; KLUDGE
+				   (clos-slots-ref ,slots ,index)))))
 			   ,@(when (or (null type) (eq type :class))
 			       `((cons (cdr ,index))))
 			   (t +slot-unbound+)))
@@ -700,8 +713,9 @@
 	  (let ((,index (pvref ,pv ,pv-offset)))
 	    (typecase ,index
 	      ,@(when (or (null type) (eq type :instance))
-                      `((fixnum (setf (clos-slots-ref ,slots ,index)
-				      ,new-value))))
+                  `((fixnum (and ,slots
+			     (setf (clos-slots-ref ,slots ,index)
+				   ,new-value)))))
 	      ,@(when (or (null type) (eq type :class))
 		  `((cons (setf (cdr ,index) ,new-value))))
 	      (t ,default)))))))
diff --git a/tests/compiler.test.sh b/tests/compiler.test.sh
index 264f474..fd948bf 100644
--- a/tests/compiler.test.sh
+++ b/tests/compiler.test.sh
@@ -130,6 +130,27 @@ cat > $tmpfilename <<EOF
 EOF
 fail_on_compiler_note $tmpfilename
 
+# test case from Rudi for some CLOS WARNINGness that shouldn't have
+# been there
+cat > $tmpfilename <<EOF
+    (eval-when (:compile-toplevel :load-toplevel :execute)
+      (defstruct buffer-state 
+        (output-index 0)))
+    
+    (defclass buffered-stream-mixin ()
+      ((buffer-state :initform (make-buffer-state))))
+    
+    (defgeneric frob (stream))
+    (defmethod frob ((stream t))
+      nil)
+    (defmethod frob ((stream buffered-stream-mixin))
+      (symbol-macrolet
+            ((index (buffer-state-output-index (slot-value stream 'buffer-state))))
+          (setf index 0))
+      (call-next-method))
+EOF
+expect_clean_compile $tmpfilename
+
 rm $tmpfilename
 rm $compiled_tmpfilename
 
diff --git a/version.lisp-expr b/version.lisp-expr
index 8e708ae..6f2dbde 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.8.6.16"
+"0.8.6.17"
-- 
1.7.10.4