From: Stas Boukarev Date: Sun, 5 Jan 2014 09:54:19 +0000 (+0400) Subject: Fix make-array transforms. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=sidebyside;p=sbcl.git 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. --- 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)))))