From 405aee8eaba55fffcf1ac2a7c74a6be4d9e63ef1 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Wed, 30 Mar 2016 21:38:34 +0300
Subject: [PATCH] Fix make-sequence type derivation with unknown types.

Unknown element-type in make-sequence got upgraded to T, which might
be not true once the type is defined at run-time.
---
 src/compiler/knownfun.lisp | 23 +++++++++++++++--------
 tests/compiler.impure.lisp | 10 ++++++++++
 2 files changed, 25 insertions(+), 8 deletions(-)

diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp
index a0efbce81..5faaed2ab 100644
--- a/src/compiler/knownfun.lisp
+++ b/src/compiler/knownfun.lisp
@@ -199,14 +199,21 @@
                 `(simple-array character ,@(if size (list size) '((*)))))))
             (t
              (let ((ctype (careful-specifier-type specifier)))
-               (if (and (array-type-p ctype)
-                        (eq (array-type-specialized-element-type ctype)
-                            *wild-type*))
-                   (make-array-type (array-type-dimensions ctype)
-                    :complexp (array-type-complexp ctype)
-                    :element-type *universal-type*
-                    :specialized-element-type *universal-type*)
-                   ctype)))))))))
+               (cond ((not (array-type-p ctype))
+                      ctype)
+                     ((unknown-type-p (array-type-element-type ctype))
+                      (make-array-type (array-type-dimensions ctype)
+                                       :complexp (array-type-complexp ctype)
+                                       :element-type *wild-type*
+                                       :specialized-element-type *wild-type*))
+                     ((eq (array-type-specialized-element-type ctype)
+                          *wild-type*)
+                      (make-array-type (array-type-dimensions ctype)
+                                       :complexp (array-type-complexp ctype)
+                                       :element-type *universal-type*
+                                       :specialized-element-type *universal-type*))
+                     (t
+                      ctype))))))))))
 
 (defun remove-non-constants-and-nils (fun)
   (lambda (list)
diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index c111d222b..5c53ea917 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -2696,3 +2696,13 @@
   (let ((name `(setf ,(gensym))))
     (assert (equal (eval `(defun ,name ()))
                    name))))
+
+(with-test (:name :make-sequence-unknown)
+  (let ((fun (checked-compile
+              `(lambda (x)
+                 (let ((vector (make-sequence '(simple-array make-sequence-unknown (*)) 10)))
+                   (setf (aref vector 0) x)
+                   vector))
+              :allow-style-warnings t)))
+    (deftype make-sequence-unknown () 'fixnum)
+    (assert-error (funcall fun 'abc) type-error)))
-- 
2.11.4.GIT