X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fseq.pure.lisp;h=e59ab96968b1e92133b005707ea5a46cc8100fc7;hb=16a6592367eec7c5e9da668ec42fd260e7705b0c;hp=a36bb350ff1953315e503fa3418e51988026ea4f;hpb=97e52e46f9bcb054eec35a9c326db75993441ca1;p=sbcl.git

diff --git a/tests/seq.pure.lisp b/tests/seq.pure.lisp
index a36bb35..e59ab96 100644
--- a/tests/seq.pure.lisp
+++ b/tests/seq.pure.lisp
@@ -64,6 +64,13 @@
 				     (make-list (- 10 j)
 						:initial-element 'a))))))))
 
+;;; And equally similarly, REMOVE-DUPLICATES misbehaved when given
+;;; :START arguments:
+
+(let ((orig (list 0 1 2 0 1 2 0 1 2 0 1 2)))
+  (assert (equalp (remove-duplicates orig :start 3 :end 9) '(0 1 2 0 1 2 0 1 2)))
+  (assert (equalp (delete-duplicates orig :start 3 :end 9) '(0 1 2 0 1 2 0 1 2))))
+
 ;;; tests of COUNT
 (assert (= 1 (count 1 '(1 2 3))))
 (assert (= 2 (count 'z #(z 1 2 3 z))))
@@ -114,3 +121,69 @@
     (ignore-errors (count-if #'zerop #(0 a 0 b c) :start 1 :from-end 11))
   (declare (ignore v))
   (assert (eql (type-error-datum e) 'c)))
+
+;;; :COUNT may be negative and BIGNUM
+(assert (equal (remove 1 '(1 2 3 1) :count 1) '(2 3 1)))
+(assert (equal (remove 1 '(1 2 3 1) :count (* 2 most-positive-fixnum)) '(2 3)))
+(assert (equal (remove 1 '(1 2 3 1) :count (* -2 most-positive-fixnum)) '(1 2 3 1)))
+
+;;; bug reported by Wolfgang Jenkner on sbcl-devel 2003-01-04:
+;;; embedded calls of SORT do not work
+(assert (equal (sort (list 0 0 0) (lambda (x y) (sort (list 0 0 0) #'<) nil))
+               '(0 0 0)))
+(assert (equal (sort (list 0 0 0 0 0)
+                     (lambda (x y)
+                       (declare (ignore x y))
+                       (block compare
+                         (sort (make-list 11 :initial-element 1)
+                               (let ((counter 7))
+                                 (lambda (x y)
+                                   (declare (ignore x y))
+                                   (when (= (decf counter) 0)
+                                     (return-from compare nil))
+                                   t))))))
+               '(0 0 0 0 0)))
+
+;;; miscellaneous sanity checks on stuff which could've been broken by
+;;; changes in MERGE-LIST* in sbcl-0.7.11.*
+(assert (equal (merge 'list () () '<) ()))
+(assert (equal (merge 'list () (list 1) #'< :key 'identity) '(1)))
+(assert (equal (merge 'list (list 2) () '>) '(2)))
+(assert (equal (merge 'list (list 1 2 4) (list 2 3 7) '<) '(1 2 2 3 4 7)))
+(assert (equal (merge 'list (list 1 2 4) (list -2 3 7) #'<) '(-2 1 2 3 4 7)))
+(assert (equal (merge 'list (list 1 2 4) (vector -2 3 7) '< :key 'abs)
+	       '(1 2 -2 3 4 7)))
+(assert (equal (merge 'list (list 1 -2 4) (list -2 3 7) '< :key #'abs)
+	       '(1 -2 -2 3 4 7)))
+(assert (equal (stable-sort (list 1 10 2 12 13 3) '<) '(1 2 3 10 12 13)))
+(assert (equal (stable-sort (list 1 10 2 12 13 3) #'< :key '-)
+	       '(13 12 10 3 2 1)))
+(assert (equal (stable-sort (list 1 10 2 12 13 3) '> :key #'-)
+	       '(1 2 3 10 12 13)))
+(assert (equal (stable-sort (list 1 2 3 -3 -2 -1) '< :key 'abs)
+	       '(1 -1 2 -2 3 -3)))
+
+;;; CSR broke FILL by not returning the sequence argument in a transform.
+(let* ((s1 (copy-seq "abcde"))
+       (s2 (fill s1 #\z)))
+  (assert s2)
+  (assert (string= s2 "zzzzz")))
+
+;;; POSITION on dispaced arrays with non-zero offset has been broken
+;;; for quite a while...
+(let ((fn (compile nil '(lambda (x) (position x)))))
+  (let* ((x #(1 2 3))
+         (y (make-array 2 :displaced-to x :displaced-index-offset 1)))
+    (assert (= (position 2 y) 0))))
+
+;;; (SIMPLE-STRING) is a legal type specifier for creation functions
+(let ((a (make-sequence '(simple-string) 5))
+      (b (concatenate '(simple-string) "a" "bdec"))
+      (c (map '(simple-string) 'identity "abcde"))
+      (d (merge '(simple-string) "acd" "be" 'char>))
+      (e (coerce '(#\a #\b #\c #\e #\d) '(simple-string))))
+  (assert (= (length a) 5))
+  (assert (string= b "abdec"))
+  (assert (string= c "abcde"))
+  (assert (string= d "beacd"))
+  (assert (string= e "abced")))