Commit aa50b824 authored by pfdietz's avatar pfdietz
Browse files

Fixed up the randomized tests; they were passing regardless of what happened. ...

Fixed up the randomized tests; they were passing regardless of what happened.  They now print out the arg list on which a failure occured.  REMOVE/etc. are failing when COUNT is negative.
parent 269fd05b
......@@ -136,8 +136,10 @@
(if start (+ start (random (- len start)))
(random (1+ len)))))
(from-end (coin))
(count (and (coin)
(random (1+ len))))
(count (case (random 5)
((0 1) nil)
((2 3) (random (1+ len)))
(t (if (coin) -1 -10000000000000))))
(seq (multiple-value-bind (x y z) (make-random-remove-input len type element-type)
y))
(key (and (coin)
......@@ -199,6 +201,8 @@
((not (equalp seq1r seq2r)) :fail3)
(t t)))))
(defparameter *remove-fail-args* nil)
(defun random-test-remove-if (maxlen &optional (negate nil))
(multiple-value-bind (element seq arg-list)
(random-test-remove-args maxlen)
......@@ -221,6 +225,7 @@
fn seq1 arg-list))
(seq2r (apply (if negate #'my-remove-if-not #'my-remove-if)
fn seq2 arg-list)))
(setq *remove-fail-args* (cons seq1 arg-list))
(cond
((not (equalp seq seq1)) :fail1)
((not (equalp seq seq2)) :fail2)
......
......@@ -266,36 +266,58 @@
(and (equalp orig x) y))
(1 2 2 6 1 2 4 1 3 2 7))
(deftest remove-list.27
(let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
(x (copy-seq orig))
(y (remove 3 x :count -1)))
(and (equalp orig x)
(equalpt x y)))
t)
(deftest remove-list.28
(let* ((orig '(1 2 3 2 6 1 2 4 1 3 2 7))
(x (copy-seq orig))
(y (remove 3 x :count -1000000000000)))
(and (equalp orig x)
(equalpt x y)))
t)
;;; Randomized tests
(deftest remove-random
(loop for i from 1 to 2500
always (random-test-remove 20))
unless (eq (random-test-remove 20) t)
do (return *remove-fail-args*))
t)
(deftest remove-if-random
(loop for i from 1 to 2500
always (random-test-remove-if 20))
unless (eq (random-test-remove-if 20) t)
do (return *remove-fail-args*))
t)
(deftest remove-if-not-random
(loop for i from 1 to 2500
always (random-test-remove-if 20 t))
unless (eq (random-test-remove-if 20 t) t)
do (return *remove-fail-args*))
t)
(deftest delete-random
(loop for i from 1 to 2500
always (random-test-delete 20))
unless (eq (random-test-delete 20) t)
do (return *remove-fail-args*))
t)
1
(deftest delete-if-random
(loop for i from 1 to 2500
always (random-test-delete-if 20))
unless (eq (random-test-delete-if 20) t)
do (return *remove-fail-args*))
t)
(deftest delete-if-not-random
(loop for i from 1 to 2500
always (random-test-delete-if 20 t))
unless (eq (random-test-delete-if 20 t) t)
do (return *remove-fail-args*))
t)
;;; Additional tests with KEY = NIL
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment