result-type-arg-value)))))
`(lambda (result-type-arg fun ,@seq-names)
(truly-the ,result-type
- ,(cond ((policy node (> speed safety))
+ ,(cond ((policy node (< safety 3))
+ ;; ANSI requires the length-related type check only
+ ;; when the SAFETY quality is 3... in other cases, we
+ ;; skip it.
bare)
((not constant-result-type-arg-p)
`(sequence-of-checked-length-given-type ,bare
(t
(let ((result-ctype (ir1-transform-specifier-type result-type)))
(if (array-type-p result-ctype)
- (let* ((dims (array-type-dimensions result-ctype))
- (dim (first dims)))
- (if (eq dim '*)
- bare
- `(vector-of-checked-length-given-length ,bare
- ,dim)))
+ (let ((dims (array-type-dimensions result-ctype)))
+ (unless (and (listp dims) (= (length dims) 1))
+ (give-up-ir1-transform "invalid sequence type"))
+ (let ((dim (first dims)))
+ (if (eq dim '*)
+ bare
+ `(vector-of-checked-length-given-length ,bare
+ ,dim))))
+ ;; FIXME: this is wrong, as not all subtypes of
+ ;; VECTOR are ARRAY-TYPEs [consider, for
+ ;; example, (OR (VECTOR T 3) (VECTOR T
+ ;; 4))]. However, it's difficult to see what we
+ ;; should put here... maybe we should
+ ;; GIVE-UP-IR1-TRANSFORM if the type is a
+ ;; subtype of VECTOR but not an ARRAY-TYPE?
bare))))))))
;;; Try to compile %MAP efficiently when we can determine sequence
(nthcdr (car (list 5)) '(1 2 . 3))))
(assert (not (eval `(locally (declare (optimize (safety 3)))
(ignore-errors (progn ,form t)))))))
+
+;;; a bug in the MAP deftransform caused non-VECTOR array specifiers
+;;; to cause errors in the compiler. Fixed by CSR in 0.7.8.10
+(assert (list (compile nil '(lambda (x) (map 'simple-array 'identity x)))))
(assert (string= (concatenate '(string 7) "foo" " " "bar") "foo bar"))
(assert-type-error (concatenate '(string 6) "foo" " " "bar"))
(assert (string= (concatenate '(string 6) "foo" #(#\b #\a #\r)) "foobar"))
- (assert-type-error (concatenate '(string 7) "foo" #(#\b #\a #\r)))))
+ (assert-type-error (concatenate '(string 7) "foo" #(#\b #\a #\r))))
+ ;; SIMPLE-ARRAY isn't allowed as a vector type specifier
+ (locally
+ (declare (optimize safety))
+ (assert-type-error (concatenate 'simple-array "foo" "bar"))
+ (assert-type-error (map 'simple-array #'identity '(1 2 3)))
+ (assert-type-error (coerce '(1 2 3) 'simple-array))
+ ;; but COERCE has an exemption clause:
+ (assert (string= "foo" (coerce "foo" 'simple-array)))))
\f
;;; success
(quit :unix-status 104)