(assert (equal '(1 2 3 4) (merge 'list-typeoid '(1 3) '(2 4) '<)))
;;; and also with types that weren't precicely LIST
(assert (equal '(1 2 3 4) (merge 'cons '(1 3) '(2 4) '<)))
+
+;;; but wait, there's more! The NULL and CONS types also have implicit
+;;; length requirements:
+(macrolet ((assert-type-error (form)
+ `(assert (typep (nth-value 1 (ignore-errors ,form))
+ 'type-error))))
+ (locally
+ (declare (optimize safety))
+ ;; MAKE-SEQUENCE
+ (assert-type-error (make-sequence 'cons 0))
+ (assert-type-error (make-sequence 'null 1))
+ ;; KLUDGE: I'm not certain that this test actually tests for what
+ ;; it should test, in that the type deriver and optimizers might
+ ;; be too smart for the good of an exhaustive test system.
+ ;; However, it makes me feel good. -- CSR, 2002-10-18
+ (assert (null (make-sequence 'null 0)))
+ (assert (= (length (make-sequence 'cons 3)) 3))
+ ;; and NIL is not a valid type for MAKE-SEQUENCE
+ (assert-type-error (make-sequence 'nil 0))
+ ;; COERCE
+ (assert-type-error (coerce #(1) 'null))
+ (assert-type-error (coerce #() 'cons))
+ (assert (null (coerce #() 'null)))
+ (assert (= (length (coerce #(1) 'cons)) 1))
+ (assert-type-error (coerce #() 'nil))
+ ;; MERGE
+ (assert-type-error (merge 'null '(1 3) '(2 4) '<))
+ (assert-type-error (merge 'cons () () '<))
+ (assert (null (merge 'null () () '<)))
+ (assert (= (length (merge 'cons '(1 3) '(2 4) '<)) 4))
+ (assert-type-error (merge 'nil () () '<))
+ ;; CONCATENATE
+ (assert-type-error (concatenate 'null '(1) "2"))
+ (assert-type-error (concatenate 'cons #() ()))
+ (assert (null (concatenate 'null () #())))
+ (assert (= (length (concatenate 'cons #() '(1) "2 3")) 4))
+ (assert-type-error (concatenate 'nil '(3)))
+ ;; FIXME: tests for MAP to come when some brave soul implements
+ ;; the analogous type checking for MAP/%MAP.
+ ))
+\f
+;;; ELT should signal an error of type TYPE-ERROR if its index
+;;; argument isn't a valid sequence index for sequence:
+(defun test-elt-signal (x)
+ (elt x 3))
+(multiple-value-bind (result error)
+ (ignore-errors (test-elt-signal "foo"))
+ (assert (null result))
+ (assert (typep error 'type-error)))
+(assert (eql (test-elt-signal "foob") #\b))
\f
;;; success
(quit :unix-status 104)