tests.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) 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 list input.
14 ;; Vector input and output is automatically coerced into list form for the list tests.
15 ;; (DEFINE-TEST FOO ...) generates FIVEAM tests FOO.VECTOR and FOO.LIST.
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-output))
25 (vector-name (intern (concatenate 'string (symbol-name name) ".VECTOR")))
26 (list-name (intern (concatenate 'string (symbol-name name) ".LIST"))))
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 7)
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 7 :from-end t)
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 0 :remove-empty-subseqs t)
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-subseqs t)
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 :count 0)
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 1 :remove-empty-subseqs t)
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-subseqs t)
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-empty-subseqs t)
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" "" "r" ""))
155 :index (index 11))
156 (is (equalp (split-sequence-if (lambda (x) (member x '(#\a #\b))) input)
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 (string x)))) input
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 (string x)))) input)
170 (values output index))))
171
172 (define-test split-sequence-if-not.1 (:input (input "abracadabra")
173 :output (output ("ab" "a" "a" "ab" "a"))
174 :index (index 11))
175 (is (equalp (split-sequence-if-not (lambda (x) (member x '(#\a #\b))) input)
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-not nil))
194 (signals program-error (split-sequence 2 '(1 2 3) :test nil :test-not #'eql))
195 (signals program-error (split-sequence 2 '(1 2 3) :test #'eql :test-not #'eql))
196 (signals program-error (split-sequence 2 '(1 2 3) :test nil :test-not nil)))
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) (print-every 10000) (fiveamp nil))
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-subseqs
210 expected-splits expected-index actual-splits actual-index)
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-SUBSEQS ~S)
215 (SPLIT-SEQUENCE 0 (COERCE ~S 'LIST)
216 :START ~S :END ~S :FROM-END ~S :COUNT ~S :REMOVE-EMPTY-SUBSEQS ~S))
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-index)))
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 :count count
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 args)))
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 args)))
256 (let* ((expected-splits (mapcar (lambda (x) (coerce x 'list)) expected-splits))
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 remove-empty-subseqs
262 expected-splits expected-index actual-splits actual-index)))
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)))))