From 495c8925e13f36e24c3b172d5fca32c17b3f3e9f Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Tue, 28 Sep 2004 12:55:55 +0000
Subject: [PATCH] The random tests of remove-duplicates and delete-duplicates
 were written in such a way they couldn't work (they passed regardless). 
 Rewrite so they actually do something useful.

---
 ansi-tests/remove-aux.lsp            | 13 ++++++++++++-
 ansi-tests/remove-duplicates-aux.lsp |  6 +++---
 ansi-tests/remove-duplicates.lsp     | 17 +++++++++++------
 3 files changed, 26 insertions(+), 10 deletions(-)

diff --git a/ansi-tests/remove-aux.lsp b/ansi-tests/remove-aux.lsp
index a3c5e38f..2910f6a4 100644
--- a/ansi-tests/remove-aux.lsp
+++ b/ansi-tests/remove-aux.lsp
@@ -9,6 +9,12 @@
   (cond
    ((subtypep* 'fixnum type)
     (random most-positive-fixnum))
+   ((and (listp type)
+	 (eql (car type) 'integer)
+	 (integerp (cadr type))
+	 (integerp (caddr type))
+	 (null (cdddr type)))
+    (+ (cadr type) (random (- (1+ (caddr type)) (cadr type)))))
    ((subtypep* '(integer 0 255) type)
     (random 255))
    ((subtypep* '(integer 0 7) type)
@@ -131,7 +137,12 @@
 
 (defun make-random-rd-params (maxlen)
   "Generate random paramaters for remove/delete/etc. functions."
-  (let* ((element-type t)
+  (let* ((element-type
+	  (rcase
+	   (2 t)
+	   (1 'bit)
+	   (1 '(integer 0 2))
+	   (1 'symbol)))
 	 (type-select (random 7))
 	 (type
 	  (case type-select
diff --git a/ansi-tests/remove-duplicates-aux.lsp b/ansi-tests/remove-duplicates-aux.lsp
index deb22677..f0e62593 100644
--- a/ansi-tests/remove-duplicates-aux.lsp
+++ b/ansi-tests/remove-duplicates-aux.lsp
@@ -86,7 +86,7 @@
 			 seq1 arg-list))
 	   (seq2r (apply #'my-remove-duplicates seq2 arg-list)))
       (cond
-       ((and pure (not (equalp seq seq1))) :fail1)
-       ((and pure (not (equalp seq seq2))) :fail2)
-       ((not (equalp seq1r seq2r)) :fail3)
+       ((and pure (not (equalp seq seq1))) (list :fail1 seq seq1r seq2r arg-list))
+       ((and pure (not (equalp seq seq2))) (list :fail2 seq seq1r seq2r arg-list))
+       ((not (equalp seq1r seq2r)) (list :fail3 seq seq1r seq2r arg-list))
        (t t)))))
diff --git a/ansi-tests/remove-duplicates.lsp b/ansi-tests/remove-duplicates.lsp
index 1c59665f..50a7aaf2 100644
--- a/ansi-tests/remove-duplicates.lsp
+++ b/ansi-tests/remove-duplicates.lsp
@@ -5,17 +5,22 @@
 
 (in-package :cl-test)
 
+(compile-and-load "remove-aux.lsp")
 (compile-and-load "remove-duplicates-aux.lsp")
 
 (deftest random-remove-duplicates
-  (loop for i from 1 to 5000
-	always (random-test-remove-dups 20))
-  t)
+  (loop for result = (random-test-remove-dups (1+ (random 20)))
+	repeat 1000
+	unless (eq result t)
+	collect result)
+  nil)
 
 (deftest random-delete-duplicates
-  (loop for i from 1 to 5000
-	always (random-test-remove-dups 20 nil))
-  t)
+  (loop for result = (random-test-remove-dups (1+ (random 20)) nil)
+	repeat 1000
+	unless (eq result t)
+	collect result)
+  nil)
 
 ;;; Look for :KEY NIL bugs
 
-- 
GitLab