From aa50b82422c096527cd46ddd9f4207ee8d8df5f7 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sun, 10 Nov 2002 22:34:33 +0000 Subject: [PATCH] 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. --- ansi-tests/remove-aux.lsp | 9 +++++++-- ansi-tests/remove.lsp | 36 +++++++++++++++++++++++++++++------- 2 files changed, 36 insertions(+), 9 deletions(-) diff --git a/ansi-tests/remove-aux.lsp b/ansi-tests/remove-aux.lsp index f46f51e1..5f27acff 100644 --- a/ansi-tests/remove-aux.lsp +++ b/ansi-tests/remove-aux.lsp @@ -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) diff --git a/ansi-tests/remove.lsp b/ansi-tests/remove.lsp index 7a1ea225..5bbb0dc1 100644 --- a/ansi-tests/remove.lsp +++ b/ansi-tests/remove.lsp @@ -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 -- GitLab