X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fseq.impure.lisp;h=92dff1116cb8df8bf2c0f943f6bd9b840706eb8a;hb=b062a0cffdc3e1706a67c487d2bc5e406c104893;hp=1339374c28ad930d4b921bf95a4c6ecdd2effaab;hpb=0f726536ee7ec85f3a9483a26d08bd7d1cd96750;p=sbcl.git

diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp
index 1339374..92dff11 100644
--- a/tests/seq.impure.lisp
+++ b/tests/seq.impure.lisp
@@ -196,7 +196,95 @@
   ;; physical ARRAY-DIMENSION 0.
   ;;
   ;; fixed in sbcl-0.7.4.22 by WHN
-  (assert (null (ignore-errors (subseq avec 1 5)))))
+  (assert (null (ignore-errors (aref (subseq avec 1 5) 0)))))
 
+;;; FILL
+(defun test-fill-typecheck (x)
+  (declare (optimize (safety 3) (space 2) (speed 1)))
+  (fill (make-string 10) x))
+
+(assert (string= (test-fill-typecheck #\@) "@@@@@@@@@@"))
+;;; BUG 186, fixed in sbcl-0.7.5.5
+(assert (null (ignore-errors (test-fill-typecheck 4097))))
+
+;;; MAKE-SEQUENCE, COERCE, CONCATENATE, MERGE, MAP and requested
+;;; result type (BUGs 46a, 46b, 66)
+(macrolet ((assert-type-error (form)
+	     `(assert (typep (nth-value 1 (ignore-errors ,form)) 
+			     'type-error))))
+  (dolist (type-stub '((simple-vector) 
+		       (vector *) 
+		       (vector (signed-byte 8))
+		       (vector (unsigned-byte 16))
+		       (vector (signed-byte 32))
+		       (simple-bit-vector)))
+    (declare (optimize safety))
+    (format t "~&~S~%" type-stub)
+    ;; MAKE-SEQUENCE
+    (assert (= (length (make-sequence `(,@type-stub) 10)) 10))
+    (assert (= (length (make-sequence `(,@type-stub 10) 10)) 10))
+    (assert-type-error (make-sequence `(,@type-stub 10) 11))
+    ;; COERCE
+    (assert (= (length (coerce '(0 0 0) `(,@type-stub))) 3))
+    (assert (= (length (coerce #(0 0 0) `(,@type-stub 3))) 3))
+    (assert-type-error (coerce #*111 `(,@type-stub 4)))
+    ;; CONCATENATE
+    (assert (= (length (concatenate `(,@type-stub) #(0 0 0) #*111)) 6))
+    (assert (equalp (concatenate `(,@type-stub) #(0 0 0) #*111)
+		   (coerce #(0 0 0 1 1 1) `(,@type-stub))))
+    (assert (= (length (concatenate `(,@type-stub 6) #(0 0 0) #*111)) 6))
+    (assert (equalp (concatenate `(,@type-stub 6) #(0 0 0) #*111)
+		   (coerce #(0 0 0 1 1 1) `(,@type-stub 6))))
+    (assert-type-error (concatenate `(,@type-stub 5) #(0 0 0) #*111))
+    ;; MERGE
+    (assert (= (length (merge `(,@type-stub) #(0 1 0) #*111 #'>)) 6))
+    (assert (equalp (merge `(,@type-stub) #(0 1 0) #*111 #'>)
+		   (coerce #(1 1 1 0 1 0) `(,@type-stub))))
+    (assert (= (length (merge `(,@type-stub 6) #(0 1 0) #*111 #'>)) 6))
+    (assert (equalp (merge `(,@type-stub 6) #(0 1 0) #*111 #'>)
+		   (coerce #(1 1 1 0 1 0) `(,@type-stub 6))))
+    (assert-type-error (merge `(,@type-stub 4) #(0 1 0) #*111 #'>))
+    ;; MAP
+    (assert (= (length (map `(,@type-stub) #'logxor #(0 0 1 1) '(0 1 0 1))) 4))
+    (assert (equalp (map `(,@type-stub) #'logxor #(0 0 1 1) '(0 1 0 1))
+		   (coerce #(0 1 1 0) `(,@type-stub))))
+    (assert (= (length (map `(,@type-stub 4) #'logxor #(0 0 1 1) '(0 1 0 1))) 
+	       4))
+    (assert (equalp (map `(,@type-stub 4) #'logxor #(0 0 1 1) '(0 1 0 1))
+		   (coerce #(0 1 1 0) `(,@type-stub 4))))
+    (assert-type-error (map `(,@type-stub 5) #'logxor #(0 0 1 1) '(0 1 0 1))))
+  ;; some more CONCATENATE tests for strings
+  (locally 
+      (declare (optimize safety))
+    (assert (string= (concatenate 'string "foo" " " "bar") "foo bar"))
+    (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))))
+  ;; Non-VECTOR ARRAY types aren't allowed as vector type specifiers.
+  (locally
+    (declare (optimize safety))
+    (assert-type-error (concatenate 'simple-array "foo" "bar"))
+    (assert-type-error (map 'simple-array #'identity '(1 2 3)))
+    (assert (equalp #(11 13)
+		    (map '(simple-array fixnum (*)) #'+ '(1 2 3) '(10 11))))
+    (assert-type-error (coerce '(1 2 3) 'simple-array))
+    (assert-type-error (merge 'simple-array '(1 3) '(2 4) '<))
+    (assert (equalp #(3 2 1) (coerce '(3 2 1) '(vector fixnum))))
+    (assert-type-error (map 'array #'identity '(1 2 3)))
+    (assert-type-error (map '(array fixnum) #'identity '(1 2 3)))
+    (assert (equalp #(1 2 3) (coerce '(1 2 3) '(vector fixnum))))
+    ;; but COERCE has an exemption clause:
+    (assert (string= "foo" (coerce "foo" 'simple-array)))
+    ;; ... though not in all cases.
+    (assert-type-error (coerce '(#\f #\o #\o) 'simple-array))))
+
+;;; As pointed out by Raymond Toy on #lisp IRC, MERGE had some issues
+;;; with user-defined types until sbcl-0.7.8.11
+(deftype list-typeoid () 'list)
+(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) '<)))
+
 ;;; success
 (quit :unix-status 104)