common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Signal an error for (make-array x :element-type undefined)

Browse source
This commit is contained in:
Stas Boukarev 2026-03-20 17:15:59 +03:00
parent ef81d38974
commit 0cd062b363
2 changed files with 8 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
src/code/array.lisp
View file

@ -261,10 +261,11 @@
fastidiously-parse)
;; Do things the hard way after falling through the tagbody.
(let* ((ctype (type-or-nil-if-unknown type))
(ctype (and ctype
(sb-kernel::replace-hairy-type ctype))))
(ctype (if ctype
(sb-kernel::replace-hairy-type ctype)
(error "~@<Unable to determine UPGRADED-ARRAY-ELEMENT-TYPE for ~s~:@_because it contains unknown types.~:>"
type))))
(typecase ctype
(null (result simple-vector-widetag))
(numeric-union-type
(case (sb-kernel::numtype-aspects-id (sb-kernel::numeric-union-type-aspects ctype))
(#.(sb-kernel::!compute-numtype-aspect-id :real 'integer nil)

13
tests/type.impure.lisp
View file

@ -58,18 +58,13 @@
;;; sbcl-0.6.10 did (UPGRADED-ARRAY-ELEMENT-TYPE 'SOME-UNDEF-TYPE)=>T
;;; and (UPGRADED-COMPLEX-PART-TYPE 'SOME-UNDEF-TYPE)=>T.
;;;
;;; some time later, we decided that (U-A-E-T 'SOME-UNDEF-TYPE) should
;;; in fact return T, and be consistent with calls like
;;; (MAKE-ARRAY <x> :ELEMENT-TYPE 'SOME-UNDEF-TYPE)
(with-test (:name (upgraded-array-element-type :undefined))
(let (array)
(handler-case
(setf array (make-array 3 :element-type 'some-undef-type))
(error () (assert-error (upgraded-array-element-type 'some-undef-type))))
(assert (eql (array-element-type array) (upgraded-array-element-type 'some-undef-type))))
(assert-error (upgraded-array-element-type 'some-undef-type))
(assert (eql (upgraded-array-element-type t) t)))
(with-test (:name (make-array :undefined-element-type))
(assert-error (make-array 0 :element-type (opaque-identity 'some-undef-type))))
(with-test (:name (upgraded-complex-part-type :undefined))
(assert-error (upgraded-complex-part-type 'some-undef-type))
(assert (subtypep (upgraded-complex-part-type 'fixnum) 'real)))