Skip to content
Snippets Groups Projects
Commit 61c463d3 authored by pfdietz's avatar pfdietz
Browse files

Added some tests showing a bug in the handling of negative count arguments to...

Added some tests showing a bug in the handling of negative count arguments to REMOVE and DELETE when the sequence is a vector.  Also, cleaned up problems in error arg reporting for the randomized REMOVE/etc. tests.
parent 2eb6491b
No related branches found
No related tags found
No related merge requests found
...@@ -32,11 +32,18 @@ ...@@ -32,11 +32,18 @@
(let* ((seq (if (subtypep* type 'list) (let* ((seq (if (subtypep* type 'list)
(loop for i from 1 to len collect (loop for i from 1 to len collect
(make-random-element element-type)) (make-random-element element-type))
(let ((seq (make-sequence type len))) (let ((seq (if (and (subtypep type 'vector)
(coin 3))
(make-array
(list (+ len (random len)))
:initial-element (make-random-element element-type)
:fill-pointer len
:element-type element-type)
(make-sequence type len))))
(dotimes (i len) (dotimes (i len)
(setf (elt seq i) (make-random-element element-type))) (setf (elt seq i) (make-random-element element-type)))
seq))) seq)))
(e (if (and (> len 0) (eql (random 2) 0)) (e (if (and (> len 0) (coin))
(elt seq (random len)) (elt seq (random len))
(make-random-element element-type))) (make-random-element element-type)))
) )
...@@ -186,6 +193,8 @@ ...@@ -186,6 +193,8 @@
(when test-not (list :test test-not))))))) (when test-not (list :test test-not)))))))
(values element seq arg-list)))) (values element seq arg-list))))
(defparameter *remove-fail-args* nil)
(defun random-test-remove (maxlen &key (tested-fn #'remove) (defun random-test-remove (maxlen &key (tested-fn #'remove)
(check-fn #'my-remove) (check-fn #'my-remove)
(pure t)) (pure t))
...@@ -195,14 +204,13 @@ ...@@ -195,14 +204,13 @@
(seq2 (copy-seq seq)) (seq2 (copy-seq seq))
(seq1r (apply tested-fn element seq1 arg-list)) (seq1r (apply tested-fn element seq1 arg-list))
(seq2r (apply check-fn element seq2 arg-list))) (seq2r (apply check-fn element seq2 arg-list)))
(setq *remove-fail-args* (list* element seq1 arg-list))
(cond (cond
((and pure (not (equalp seq seq1))) :fail1) ((and pure (not (equalp seq seq1))) :fail1)
((and pure (not (equalp seq seq2))) :fail2) ((and pure (not (equalp seq seq2))) :fail2)
((not (equalp seq1r seq2r)) :fail3) ((not (equalp seq1r seq2r)) :fail3)
(t t))))) (t t)))))
(defparameter *remove-fail-args* nil)
(defun random-test-remove-if (maxlen &optional (negate nil)) (defun random-test-remove-if (maxlen &optional (negate nil))
(multiple-value-bind (element seq arg-list) (multiple-value-bind (element seq arg-list)
(random-test-remove-args maxlen) (random-test-remove-args maxlen)
...@@ -251,6 +259,7 @@ ...@@ -251,6 +259,7 @@
(t nil)) (t nil))
(setf fn (if (coin) 'identity (setf fn (if (coin) 'identity
#'(lambda (x) (funcall test element x))))) #'(lambda (x) (funcall test element x)))))
(setq *remove-fail-args* (list* seq arg-list))
(let* ((seq1 (copy-seq seq)) (let* ((seq1 (copy-seq seq))
(seq2 (copy-seq seq)) (seq2 (copy-seq seq))
(seq1r (apply (if negate #'delete-if-not #'delete-if) (seq1r (apply (if negate #'delete-if-not #'delete-if)
......
...@@ -282,6 +282,31 @@ ...@@ -282,6 +282,31 @@
(equalpt x y))) (equalpt x y)))
t) t)
(deftest remove-vector.1
(remove 'a (vector 'b 'c 'd))
#(b c d))
(deftest remove-vector.2
(remove 'a (vector 'b 'c 'd) :count -1)
#(b c d))
(deftest remove-vector.3
(remove 'a (vector 'a 'b 'c 'd) :count -1)
#(a b c d))
(deftest delete-vector.1
(delete 'a (vector 'b 'c 'd))
#(b c d))
(deftest delete-vector.2
(delete 'a (vector 'b 'c 'd) :count -1)
#(b c d))
(deftest delete-vector.3
(delete 'a (vector 'a 'b 'c 'd) :count -1)
#(a b c d))
;;; Randomized tests ;;; Randomized tests
(deftest remove-random (deftest remove-random
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment