(eql 5 (position-if (lambda (c) (equal #\g c)) seq))
(eql 5 (position-if (lambda (c) (equal #\g c)) seq :from-end t))
(find-if #'characterp seq)
- (find-if #'(lambda (c) (typep c 'base-char)) seq :from-end t)
+ (find-if (lambda (c) (typep c 'base-char)) seq :from-end t)
(null (find-if 'upper-case-p seq))))
+;;; SUBSEQ
+(let ((avec (make-array 10
+ :fill-pointer 4
+ :initial-contents '(0 1 2 3 iv v vi vii iix ix))))
+ ;; These first five always worked AFAIK.
+ (assert (equalp (subseq avec 0 3) #(0 1 2)))
+ (assert (equalp (subseq avec 3 3) #()))
+ (assert (equalp (subseq avec 1 3) #(1 2)))
+ (assert (equalp (subseq avec 1) #(1 2 3)))
+ (assert (equalp (subseq avec 1 4) #(1 2 3)))
+ ;; SBCL bug found ca. 2002-05-01 by OpenMCL's correct handling of
+ ;; SUBSEQ, CSR's driving portable cross-compilation far enough to
+ ;; reach the SUBSEQ calls in assem.lisp, and WHN's sleazy
+ ;; translation of old CMU CL new-assem.lisp into sufficiently grotty
+ ;; portable Lisp that it passed suitable illegal values to SUBSEQ to
+ ;; exercise the bug:-|
+ ;;
+ ;; SUBSEQ should check its END value against logical LENGTH, not
+ ;; physical ARRAY-DIMENSION 0.
+ ;;
+ ;; fixed in sbcl-0.7.4.22 by WHN
+ (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))))
+ ;; 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)
projects / sbcl.git / blobdiff