diff --git a/ansi-tests/remove-aux.lsp b/ansi-tests/remove-aux.lsp index a3c5e38fd5a4026cb945a7563f564f7525381705..2910f6a40c6e4bcba8a141746c738cdfab08ec32 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 deb226777b96df7316fc5493df55a980ac0796f3..f0e625936612e254cbf2062fffc0335c276379d8 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 1c59665f7943ab2efb006e9df47683b5a67db805..50a7aaf2b12f127a6cf4fe4f254559eeb4519e7c 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