From: Paul Khuong <pvk@pvk.ca>
Date: Sat, 22 Oct 2011 01:38:00 +0000 (-0400)
Subject: Fix a long-standing bug in (PRIMITIVE-TYPE [MEMBER type])
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=082940f3f469b8421c54615d7be5bd27aa4c11fb;p=sbcl.git

Fix a long-standing bug in (PRIMITIVE-TYPE [MEMBER type])

 A refactoring in 1.0.12.18 resulted in overly-optimistic primitive
 type.

 Reported by Eric Marsden on sbcl-devel.
---

diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp
index 43c5e26..4fee64c 100644
--- a/src/compiler/generic/primtype.lisp
+++ b/src/compiler/generic/primtype.lisp
@@ -356,8 +356,8 @@
                               (setq res new-ptype)
                               (return (any)))))
                       (setf res ptype))))
-              type))
-           res))
+              type)
+             res)))
         (named-type
          (ecase (named-type-name type)
            ((t *) (values *backend-t-primitive-type* t))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index fbdd62b..3bc80da 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4001,3 +4001,13 @@
                              (+ #C(0.0 1.0) x)))))
     (assert (= (funcall fun #C(1.0 2.0))
                #C(1.0 3.0)))))
+
+;; A refactoring  1.0.12.18 caused lossy computation of primitive
+;; types for member types.
+(with-test (:name :member-type-primitive-type)
+  (let ((fun (compile nil `(lambda (p1 p2 p3)
+                             (if p1
+                                 (the (member #c(1.2d0 1d0)) p2)
+                                 (the (eql #c(1.0 1.0)) p3))))))
+    (assert (eql (funcall fun 1 #c(1.2d0 1d0) #c(1.0 1.0))
+                 #c(1.2d0 1.0d0)))))