From 260de2062fca170efdac3e42491d7d866c2d2e56 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Sun, 5 Jan 2014 13:54:19 +0400
Subject: [PATCH] Fix make-array transforms.
Don't call UPGRADED-ARRAY-ELEMENT-TYPE on types without checking that
they don't contain unknown types (i.e., intersections or unions
containing unknown-type), since U-A-E-T now signals errors for these.
Reported by Bart Botta.
---
package-data-list.lisp-expr | 1 +
src/code/late-type.lisp | 7 +++++++
src/compiler/array-tran.lisp | 4 ++--
src/compiler/generic/vm-type.lisp | 7 -------
tests/compiler.pure.lisp | 8 +++++++-
5 files changed, 17 insertions(+), 10 deletions(-)
diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 72bf994..612236d 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1351,6 +1351,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
"%COMPARE-AND-SWAP-SYMBOL-VALUE"
"%CONCATENATE-TO-BASE-STRING"
"%CONCATENATE-TO-STRING"
+ "CONTAINS-UNKNOWN-TYPE-P"
"%COS" "%COS-QUICK"
"%COSH" "%DATA-VECTOR-AND-INDEX" "%DEPOSIT-FIELD"
"%DOUBLE-FLOAT" "%DPB" "%EQL"
diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 04a93f2..8190493 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -49,6 +49,13 @@
(funcall method type2 type1)
(hierarchical-intersection2 type1 type2))))
+(defun contains-unknown-type-p (ctype)
+ (cond ((unknown-type-p ctype) t)
+ ((intersection-type-p ctype)
+ (some #'contains-unknown-type-p (intersection-type-types ctype)))
+ ((union-type-p ctype)
+ (some #'contains-unknown-type-p (union-type-types ctype)))))
+
;;; This is used by !DEFINE-SUPERCLASSES to define the SUBTYPE-ARG1
;;; method. INFO is a list of conses
;;; (SUPERCLASS-CLASS . {GUARD-TYPE-SPECIFIER | NIL}).
diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index c44afb4..bc2fc02 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -294,7 +294,7 @@
(let ((ctype (careful-specifier-type
(lvar-value element-type))))
(cond
- ((or (null ctype) (unknown-type-p ctype)) '*)
+ ((or (null ctype) (contains-unknown-type-p ctype)) '*)
(t (sb!xc:upgraded-array-element-type
(lvar-value element-type))))))
(t
@@ -639,7 +639,7 @@
(element-type-ctype (and (constant-lvar-p element-type)
(ir1-transform-specifier-type
(lvar-value element-type)))))
- (when (unknown-type-p element-type-ctype)
+ (when (contains-unknown-type-p element-type-ctype)
(give-up-ir1-transform))
(unless (every #'integerp dims)
(give-up-ir1-transform
diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp
index 9d0a031..5c78b2b 100644
--- a/src/compiler/generic/vm-type.lisp
+++ b/src/compiler/generic/vm-type.lisp
@@ -107,13 +107,6 @@
(double-float 'double-float)
#!+long-float (long-float 'long-float)))
-(defun contains-unknown-type-p (ctype)
- (cond ((unknown-type-p ctype) t)
- ((intersection-type-p ctype)
- (some #'contains-unknown-type-p (intersection-type-types ctype)))
- ((union-type-p ctype)
- (some #'contains-unknown-type-p (union-type-types ctype)))))
-
;;; This function is called when the type code wants to find out how
;;; an array will actually be implemented. We set the
;;; SPECIALIZED-ELEMENT-TYPE to correspond to the actual
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 1fd9166..604e176 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4973,4 +4973,10 @@
(with-test (:name :upgraded-array-element-type-undefined-type)
(raises-error? (upgraded-array-element-type 'an-undefined-type))
- (raises-error? (upgraded-array-element-type '(and fixnum an-undefined-type))))
+ (raises-error? (upgraded-array-element-type '(and fixnum an-undefined-type)))
+ (compile nil '(lambda ()
+ (make-array 10
+ :element-type '(or null an-undefined-type))))
+ (compile nil '(lambda ()
+ (make-array '(10 10)
+ :element-type '(or null an-undefined-type)))))
--
1.7.10.4