19 |
(assert (integerp start)) |
(assert (integerp start)) |
20 |
(assert (integerp end)) |
(assert (integerp end)) |
21 |
(assert (<= 0 start end len)) |
(assert (<= 0 start end len)) |
22 |
(format t "start = ~A, end = ~A, len = ~A~%" start end len) |
;; (format t "start = ~A, end = ~A, len = ~A~%" start end len) |
23 |
(if from-end |
(if from-end |
24 |
(psetq start (- len end) |
(psetq start (- len end) |
25 |
end (- len start) |
end (- len start) |
26 |
sequence (reverse sequence)) |
sequence (reverse sequence)) |
27 |
(setq sequence (copy-seq sequence))) |
(setq sequence (copy-seq sequence))) |
28 |
(format t "start = ~A, end = ~A, len = ~A~%" start end len) |
;; (format t "start = ~A, end = ~A, len = ~A~%" start end len) |
29 |
(assert (<= 0 start end len) (start end len)) |
(assert (<= 0 start end len) (start end len)) |
30 |
(let ((result nil)) |
(let ((result nil)) |
31 |
(loop for i from 0 below start |
(loop for i from 0 below start |
32 |
do (push (elt sequence i) result)) |
do (push (elt sequence i) result)) |
33 |
(loop for i from start below end |
(loop for i from start below end |
34 |
for x = (elt sequence i) |
for x = (elt sequence i) |
35 |
unless (position x |
for kx = (if key (funcall key x) x) |
36 |
|
unless (position kx |
37 |
sequence |
sequence |
38 |
:start (1+ i) |
:start (1+ i) |
39 |
:end end |
:end end |
50 |
:element-type (array-element-type orig-sequence))) |
:element-type (array-element-type orig-sequence))) |
51 |
(t (assert nil)))))) |
(t (assert nil)))))) |
52 |
|
|
53 |
|
(defun make-random-rdup-params (maxlen) |
54 |
|
"Make random input parameters for REMOVE-DUPLICATES." |
55 |
|
(multiple-value-bind (element-type type len start end from-end |
56 |
|
count seq key test test-not) |
57 |
|
(make-random-rd-params maxlen) |
58 |
|
(declare (ignore count element-type)) |
59 |
|
(let ((arg-list |
60 |
|
(reduce #'nconc |
61 |
|
(random-permute |
62 |
|
(list |
63 |
|
(when start (list :start start)) |
64 |
|
(cond (end (list :end end)) |
65 |
|
((coin) (list :end nil))) |
66 |
|
(cond (from-end (list :from-end from-end)) |
67 |
|
((coin) (list :from-end nil))) |
68 |
|
(cond (key (list :key key)) |
69 |
|
;; ((coin) (list :key nil)) |
70 |
|
) |
71 |
|
(when test (list :test test)) |
72 |
|
(when test-not (list :test test-not))))))) |
73 |
|
(values seq arg-list)))) |
74 |
|
|
75 |
|
(defun random-test-remove-dups (maxlen &optional (pure t)) |
76 |
|
(multiple-value-bind (seq arg-list) |
77 |
|
(make-random-rdup-params maxlen) |
78 |
|
(let* ((seq1 (copy-seq seq)) |
79 |
|
(seq2 (copy-seq seq)) |
80 |
|
(seq1r (apply (if pure #'remove-duplicates |
81 |
|
#'delete-duplicates) |
82 |
|
seq1 arg-list)) |
83 |
|
(seq2r (apply #'my-remove-duplicates seq2 arg-list))) |
84 |
|
(cond |
85 |
|
((and pure (not (equalp seq seq1))) :fail1) |
86 |
|
((and pure (not (equalp seq seq2))) :fail2) |
87 |
|
((not (equalp seq1r seq2r)) :fail3) |
88 |
|
(t t))))) |