32 |
(let* ((seq (if (subtypep* type 'list) |
(let* ((seq (if (subtypep* type 'list) |
33 |
(loop for i from 1 to len collect |
(loop for i from 1 to len collect |
34 |
(make-random-element element-type)) |
(make-random-element element-type)) |
35 |
(let ((seq (make-sequence type len))) |
(let ((seq (if (and (subtypep type 'vector) |
36 |
|
(coin 3)) |
37 |
|
(make-array |
38 |
|
(list (+ len (random len))) |
39 |
|
:initial-element (make-random-element element-type) |
40 |
|
:fill-pointer len |
41 |
|
:element-type element-type) |
42 |
|
(make-sequence type len)))) |
43 |
(dotimes (i len) |
(dotimes (i len) |
44 |
(setf (elt seq i) (make-random-element element-type))) |
(setf (elt seq i) (make-random-element element-type))) |
45 |
seq))) |
seq))) |
46 |
(e (if (and (> len 0) (eql (random 2) 0)) |
(e (if (and (> len 0) (coin)) |
47 |
(elt seq (random len)) |
(elt seq (random len)) |
48 |
(make-random-element element-type))) |
(make-random-element element-type))) |
49 |
) |
) |
193 |
(when test-not (list :test test-not))))))) |
(when test-not (list :test test-not))))))) |
194 |
(values element seq arg-list)))) |
(values element seq arg-list)))) |
195 |
|
|
196 |
|
(defparameter *remove-fail-args* nil) |
197 |
|
|
198 |
(defun random-test-remove (maxlen &key (tested-fn #'remove) |
(defun random-test-remove (maxlen &key (tested-fn #'remove) |
199 |
(check-fn #'my-remove) |
(check-fn #'my-remove) |
200 |
(pure t)) |
(pure t)) |
204 |
(seq2 (copy-seq seq)) |
(seq2 (copy-seq seq)) |
205 |
(seq1r (apply tested-fn element seq1 arg-list)) |
(seq1r (apply tested-fn element seq1 arg-list)) |
206 |
(seq2r (apply check-fn element seq2 arg-list))) |
(seq2r (apply check-fn element seq2 arg-list))) |
207 |
|
(setq *remove-fail-args* (list* element seq1 arg-list)) |
208 |
(cond |
(cond |
209 |
((and pure (not (equalp seq seq1))) :fail1) |
((and pure (not (equalp seq seq1))) :fail1) |
210 |
((and pure (not (equalp seq seq2))) :fail2) |
((and pure (not (equalp seq seq2))) :fail2) |
211 |
((not (equalp seq1r seq2r)) :fail3) |
((not (equalp seq1r seq2r)) :fail3) |
212 |
(t t))))) |
(t t))))) |
213 |
|
|
|
(defparameter *remove-fail-args* nil) |
|
|
|
|
214 |
(defun random-test-remove-if (maxlen &optional (negate nil)) |
(defun random-test-remove-if (maxlen &optional (negate nil)) |
215 |
(multiple-value-bind (element seq arg-list) |
(multiple-value-bind (element seq arg-list) |
216 |
(random-test-remove-args maxlen) |
(random-test-remove-args maxlen) |
259 |
(t nil)) |
(t nil)) |
260 |
(setf fn (if (coin) 'identity |
(setf fn (if (coin) 'identity |
261 |
#'(lambda (x) (funcall test element x))))) |
#'(lambda (x) (funcall test element x))))) |
262 |
|
(setq *remove-fail-args* (list* seq arg-list)) |
263 |
(let* ((seq1 (copy-seq seq)) |
(let* ((seq1 (copy-seq seq)) |
264 |
(seq2 (copy-seq seq)) |
(seq2 (copy-seq seq)) |
265 |
(seq1r (apply (if negate #'delete-if-not #'delete-if) |
(seq1r (apply (if negate #'delete-if-not #'delete-if) |