X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fseq.pure.lisp;h=2c1d638f7a1caf8f0b0bdb47cd2bc4b249db466c;hb=4bc105c259d2f6e0df7bcc6ceb72d5a75bb4e720;hp=7eac06886fe8415d28bc963ffff4d4d72242c45d;hpb=42cb633f2a06d5cbe6b0ec86920cb0d662c49843;p=sbcl.git

diff --git a/tests/seq.pure.lisp b/tests/seq.pure.lisp
index 7eac068..2c1d638 100644
--- a/tests/seq.pure.lisp
+++ b/tests/seq.pure.lisp
@@ -11,6 +11,8 @@
 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
 ;;;; more information.
 
+(in-package :cl-user)
+
 ;;; As reported by Paul Dietz from his ansi-test suite for gcl, REMOVE
 ;;; malfunctioned when given :START, :END and :FROM-END arguments.
 ;;; Make sure it doesn't happen again.
@@ -187,3 +189,64 @@
   (assert (string= c "abcde"))
   (assert (string= d "beacd"))
   (assert (string= e "abced")))
+
+;;; COPY-SEQ "should be prepared to signal an error if sequence is not
+;;; a proper sequence".
+(locally (declare (optimize safety))
+  (multiple-value-bind (seq err) (ignore-errors (copy-seq '(1 2 3 . 4)))
+    (assert (not seq))
+    (assert (typep err 'type-error))))
+
+;;; UBX-BASH-COPY transform had an inconsistent return type
+(let ((sb-c::*check-consistency* t))
+  (handler-bind ((warning #'error))
+    (compile nil
+             '(lambda (l)
+               (declare (type fixnum l))
+               (let* ((bsize 128)
+                      (b1 (make-array bsize :element-type '(unsigned-byte 8)))
+                      (b2 (make-array l :element-type '(unsigned-byte 8))))
+                 (replace b1 b2 :start2 0 :end2 l))))))
+
+(with-test (:name :bug-452008)
+  ;; FIND & POSITION on lists should check bounds and (in safe code) detect
+  ;; circular and dotted lists.
+  (macrolet ((test (type lambda)
+               `(let ((got (handler-case
+                               (funcall (compile nil ',lambda))
+                             (,type () :error)
+                             (:no-error (res)
+                               (list :no-error res)))))
+                  (let ((*print-circle* t))
+                    (format t "test: ~S~%" ',lambda))
+                  (unless (eq :error got)
+                    (error "wanted an error, got ~S for~%  ~S"
+                           (second got) ',lambda)))))
+    (test sb-kernel:bounding-indices-bad-error
+          (lambda ()
+            (find :foo '(1 2 3 :foo) :start 1 :end 5 :from-end t)))
+    (test sb-kernel:bounding-indices-bad-error
+          (lambda ()
+            (position :foo '(1 2 3 :foo) :start 1 :end 5 :from-end t)))
+    (test sb-kernel:bounding-indices-bad-error
+          (lambda ()
+            (find :foo '(1 2 3 :foo) :start 3 :end 0 :from-end t)))
+    (test sb-kernel:bounding-indices-bad-error
+          (lambda ()
+            (position :foo '(1 2 3 :foo) :start 3 :end 0 :from-end t)))
+    (test type-error
+          (lambda ()
+            (let ((list (list 1 2 3 :foo)))
+              (find :bar (nconc list list)))))
+    (test type-error
+          (lambda ()
+            (let ((list (list 1 2 3 :foo)))
+              (position :bar (nconc list list)))))))
+
+(with-test (:name :bug-554385)
+  ;; FIND-IF shouldn't look through the entire list.
+  (assert (= 2 (find-if #'evenp '(1 2 1 1 1 1 1 1 1 1 1 1 :foo))))
+  ;; Even though the end bounds are incorrect, the
+  ;; element is found before that's an issue.
+  (assert (eq :foo (find :foo '(1 2 3 :foo) :start 1 :end 5)))
+  (assert (= 3 (position :foo '(1 2 3 :foo) :start 1 :end 5))))