tests.lisp - clic - Clic is an command line interactive client for gopher writt… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
tests.lisp (12989B) | |
--- | |
1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- | |
2 | |
3 (defpackage :split-sequence/tests | |
4 (:use :common-lisp :split-sequence :fiveam)) | |
5 | |
6 (in-package :split-sequence/tests) | |
7 | |
8 (in-suite* :split-sequence) | |
9 | |
10 ;;; UNIT TESTS | |
11 | |
12 (defmacro define-test (name (&key input output index) &body forms) | |
13 ;; This macro automatically generates test code for testing vector and… | |
14 ;; Vector input and output is automatically coerced into list form for… | |
15 ;; (DEFINE-TEST FOO ...) generates FIVEAM tests FOO.VECTOR and FOO.LIS… | |
16 (check-type name symbol) | |
17 (check-type input (cons symbol (cons vector null))) | |
18 (check-type output (cons symbol (cons list null))) | |
19 (check-type index (cons symbol (cons unsigned-byte null))) | |
20 (let* ((input-symbol (first input)) (vector-input (second input)) | |
21 (output-symbol (first output)) (vector-output (second output)) | |
22 (index-symbol (first index)) (index-value (second index)) | |
23 (list-input (coerce vector-input 'list)) | |
24 (list-output (mapcar (lambda (x) (coerce x 'list)) vector-outpu… | |
25 (vector-name (intern (concatenate 'string (symbol-name name) ".… | |
26 (list-name (intern (concatenate 'string (symbol-name name) ".LI… | |
27 `(progn | |
28 (test (,vector-name :compile-at :definition-time) | |
29 (let ((,input-symbol ',vector-input) | |
30 (,output-symbol ',vector-output) | |
31 (,index-symbol ,index-value)) | |
32 ,@forms)) | |
33 (test (,list-name :compile-at :definition-time) | |
34 (let ((,input-symbol ',list-input) | |
35 (,output-symbol ',list-output) | |
36 (,index-symbol ,index-value)) | |
37 ,@forms))))) | |
38 | |
39 (define-test split-sequence.0 (:input (input "") | |
40 :output (output ("")) | |
41 :index (index 0)) | |
42 (is (equalp (split-sequence #\; input) | |
43 (values output index)))) | |
44 | |
45 (define-test split-sequence.1 (:input (input "a;;b;c") | |
46 :output (output ("a" "" "b" "c")) | |
47 :index (index 6)) | |
48 (is (equalp (split-sequence #\; input) | |
49 (values output index)))) | |
50 | |
51 (define-test split-sequence.2 (:input (input "a;;b;c") | |
52 :output (output ("a" "" "b" "c")) | |
53 :index (index 0)) | |
54 (is (equalp (split-sequence #\; input :from-end t) | |
55 (values output index)))) | |
56 | |
57 (define-test split-sequence.3 (:input (input "a;;b;c") | |
58 :output (output ("c")) | |
59 :index (index 4)) | |
60 (is (equalp (split-sequence #\; input :from-end t :count 1) | |
61 (values output index)))) | |
62 | |
63 (define-test split-sequence.4 (:input (input "a;;b;c") | |
64 :output (output ("a" "b" "c")) | |
65 :index (index 6)) | |
66 (is (equalp (split-sequence #\; input :remove-empty-subseqs t) | |
67 (values output index)))) | |
68 | |
69 (define-test split-sequence.5 (:input (input ";oo;bar;ba;") | |
70 :output (output ("oo" "bar" "b")) | |
71 :index (index 9)) | |
72 (is (equalp (split-sequence #\; input :start 1 :end 9) | |
73 (values output index)))) | |
74 | |
75 (define-test split-sequence.6 (:input (input "abracadabra") | |
76 :output (output ("" "br" "c" "d" "br" "")) | |
77 :index (index 11)) | |
78 (is (equalp (split-sequence #\A input :key #'char-upcase) | |
79 (values output index)))) | |
80 | |
81 (define-test split-sequence.7 (:input (input "abracadabra") | |
82 :output (output ("r" "c" "d")) | |
83 :index (index 7)) | |
84 (is (equalp (split-sequence #\A input :key #'char-upcase :start 2 :end… | |
85 (values output index)))) | |
86 | |
87 (define-test split-sequence.8 (:input (input "abracadabra") | |
88 :output (output ("r" "c" "d")) | |
89 :index (index 2)) | |
90 (is (equalp (split-sequence #\A input :key #'char-upcase :start 2 :end… | |
91 (values output index)))) | |
92 | |
93 (define-test split-sequence.9 (:input (input #(1 2 0)) | |
94 :output (output (#(1 2) #())) | |
95 :index (index 0)) | |
96 (is (equalp (split-sequence 0 input :from-end t) | |
97 (values output index)))) | |
98 | |
99 (define-test split-sequence.10 (:input (input #(2 0 0 2 3 2 0 1 0 3)) | |
100 :output (output ()) | |
101 :index (index 8)) | |
102 (is (equalp (split-sequence 0 input :start 8 :end 9 :from-end t :count… | |
103 (values output index)))) | |
104 | |
105 (define-test split-sequence.11 (:input (input #(0 1 3 0 3 1 2 2 1 0)) | |
106 :output (output ()) | |
107 :index (index 0)) | |
108 (is (equalp (split-sequence 0 input :start 0 :end 0 :remove-empty-subs… | |
109 (values output index)))) | |
110 | |
111 (define-test split-sequence.12 (:input (input #(3 0 0 0 3 3 0 3 1 0)) | |
112 :output (output ()) | |
113 :index (index 10)) | |
114 (is (equalp (split-sequence 0 input :start 9 :end 10 :from-end t :coun… | |
115 (values output index)))) | |
116 | |
117 (define-test split-sequence.13 (:input (input #(3 3 3 3 0 2 0 0 1 2)) | |
118 :output (output (#(1))) | |
119 :index (index 6)) | |
120 (is (equalp (split-sequence 0 input :start 6 :end 9 :from-end t :count… | |
121 (values output index)))) | |
122 | |
123 (define-test split-sequence.14 (:input (input #(1 0)) | |
124 :output (output (#(1))) | |
125 :index (index 0)) | |
126 (is (equalp (split-sequence 0 input :from-end t :count 1 :remove-empty… | |
127 (values output index)))) | |
128 | |
129 (define-test split-sequence.15 (:input (input #(0 0)) | |
130 :output (output ()) | |
131 :index (index 1)) | |
132 (is (equalp (split-sequence 0 input :start 0 :end 1 :count 0 :remove-e… | |
133 (values output index)))) | |
134 | |
135 (define-test split-sequence.16 (:input (input "a;;b;c") | |
136 :output (output ("" ";;" ";" "")) | |
137 :index (index 6)) | |
138 (is (equalp (split-sequence #\; input :test-not #'eql) | |
139 (values output index)))) | |
140 | |
141 (define-test split-sequence.17 (:input (input "a;;b;c") | |
142 :output (output ("" ";;" ";" "")) | |
143 :index (index 0)) | |
144 (is (equalp (split-sequence #\; input :from-end t :test-not #'eql) | |
145 (values output index)))) | |
146 | |
147 (define-test split-sequence.18 (:input (input #(1 0 2 0 3 0 4)) | |
148 :output (output (#(1) #(2) #(3))) | |
149 :index (index 6)) | |
150 (is (equalp (split-sequence 0 input :count 3) | |
151 (values output index)))) | |
152 | |
153 (define-test split-sequence-if.1 (:input (input "abracadabra") | |
154 :output (output ("" "" "r" "c" "d" "" … | |
155 :index (index 11)) | |
156 (is (equalp (split-sequence-if (lambda (x) (member x '(#\a #\b))) inpu… | |
157 (values output index)))) | |
158 | |
159 (define-test split-sequence-if.2 (:input (input "123456") | |
160 :output (output ("1" "3" "5")) | |
161 :index (index 6)) | |
162 (is (equalp (split-sequence-if (lambda (x) (evenp (parse-integer (stri… | |
163 :remove-empty-subseqs t) | |
164 (values output index)))) | |
165 | |
166 (define-test split-sequence-if.3 (:input (input "123456") | |
167 :output (output ("1" "3" "5" "")) | |
168 :index (index 6)) | |
169 (is (equalp (split-sequence-if (lambda (x) (evenp (parse-integer (stri… | |
170 (values output index)))) | |
171 | |
172 (define-test split-sequence-if-not.1 (:input (input "abracadabra") | |
173 :output (output ("ab" "a" "a" "ab"… | |
174 :index (index 11)) | |
175 (is (equalp (split-sequence-if-not (lambda (x) (member x '(#\a #\b))) … | |
176 (values output index)))) | |
177 | |
178 (test split-sequence.start-end-error | |
179 (signals error (split-sequence 0 #(0 1 2 3) :start nil)) | |
180 (signals error (split-sequence 0 #(0 1 2 3) :end '#:end)) | |
181 (signals error (split-sequence 0 #(0 1 2 3) :start 0 :end 8)) | |
182 (signals error (split-sequence 0 #(0 1 2 3) :start 2 :end 0))) | |
183 | |
184 (test split-sequence.test-provided | |
185 ;; Neither provided | |
186 (is (equal '((1) (3)) (split-sequence 2 '(1 2 3)))) | |
187 ;; Either provided | |
188 (is (equal '((1) (3)) (split-sequence 2 '(1 2 3) :test #'eql))) | |
189 (is (equal '(() (2) ()) (split-sequence 2 '(1 2 3) :test-not #'eql))) | |
190 (signals type-error (split-sequence 2 '(1 2 3) :test nil)) | |
191 (signals type-error (split-sequence 2 '(1 2 3) :test-not nil)) | |
192 ;; Both provided | |
193 (signals program-error (split-sequence 2 '(1 2 3) :test #'eql :test-no… | |
194 (signals program-error (split-sequence 2 '(1 2 3) :test nil :test-not … | |
195 (signals program-error (split-sequence 2 '(1 2 3) :test #'eql :test-no… | |
196 (signals program-error (split-sequence 2 '(1 2 3) :test nil :test-not … | |
197 | |
198 ;;; FUZZ TEST | |
199 | |
200 (test split-sequence.fuzz | |
201 (fuzz :verbose nil :fiveamp t)) | |
202 | |
203 (defun fuzz (&key (max-length 100) (repetitions 1000000) (verbose t) (pr… | |
204 (flet ((random-vector (n) | |
205 (let ((vector (make-array n :element-type '(unsigned-byte 2))… | |
206 (dotimes (i n) (setf (aref vector i) (random 4))) | |
207 vector)) | |
208 (random-boolean () (if (= 0 (random 2)) t nil)) | |
209 (fuzz-failure (vector start end from-end count remove-empty-sub… | |
210 expected-splits expected-index actual-splits act… | |
211 (format nil "Fuzz failure: | |
212 \(MULTIPLE-VALUE-CALL #'VALUES | |
213 (SPLIT-SEQUENCE 0 ~S | |
214 :START ~S :END ~S :FROM-END ~S :COUNT ~S :REMOVE-EMPTY… | |
215 (SPLIT-SEQUENCE 0 (COERCE ~S 'LIST) | |
216 :START ~S :END ~S :FROM-END ~S :COUNT ~S :REMOVE-EMPTY… | |
217 ~S~%~S~%~S~%~S" | |
218 vector start end from-end count remove-empty-subseqs | |
219 vector start end from-end count remove-empty-subseqs | |
220 expected-splits expected-index actual-splits actual-i… | |
221 (let ((failure-string nil) | |
222 (predicate (lambda (x) (= x 0))) | |
223 (predicate-not (lambda (x) (/= x 0)))) | |
224 (dotimes (i repetitions) | |
225 (when (and verbose (= 0 (mod (1+ i) print-every))) | |
226 (format t "Fuzz: Pass ~D passed.~%" (1+ i))) | |
227 (let* ((length (1+ (random max-length))) | |
228 (vector (random-vector length)) | |
229 (list (coerce vector 'list)) | |
230 (remove-empty-subseqs (random-boolean)) | |
231 (start 0) end from-end count) | |
232 (case (random 5) | |
233 (0) | |
234 (1 (setf start (random length))) | |
235 (2 (setf start (random length) | |
236 end (+ start (random (1+ (- length start)))))) | |
237 (3 (setf start (random length) | |
238 end (+ start (random (1+ (- length start)))) | |
239 from-end t)) | |
240 (4 (setf start (random length) | |
241 end (+ start (random (1+ (- length start)))) | |
242 from-end t | |
243 count (random (1+ (- end start)))))) | |
244 (let ((args (list :start start :end end :from-end from-end :co… | |
245 :remove-empty-subseqs remove-empty-subseqs))) | |
246 (multiple-value-bind (expected-splits expected-index) | |
247 (case (random 3) | |
248 (0 (apply #'split-sequence 0 vector args)) | |
249 (1 (apply #'split-sequence-if predicate vector args)) | |
250 (2 (apply #'split-sequence-if-not predicate-not vector… | |
251 (multiple-value-bind (actual-splits actual-index) | |
252 (case (random 3) | |
253 (0 (apply #'split-sequence 0 list args)) | |
254 (1 (apply #'split-sequence-if predicate list args)) | |
255 (2 (apply #'split-sequence-if-not predicate-not list… | |
256 (let* ((expected-splits (mapcar (lambda (x) (coerce x 'l… | |
257 (result (and (equal actual-splits expected-splits) | |
258 (= expected-index actual-index)))) | |
259 (unless result | |
260 (let ((string (fuzz-failure | |
261 vector start end from-end count remov… | |
262 expected-splits expected-index actual… | |
263 (cond (fiveamp | |
264 (setf failure-string string) | |
265 (return)) | |
266 (t (assert result () string))))))))))) | |
267 (when fiveamp | |
268 (is (not failure-string) failure-string))))) |