Recently Written · git

clic

MIRROR ONLY Gopher client with pretty colours in Common Lisp

git clone https://github.com/equwal/clic

Log | Files | Refs


3rdparties/software/split-sequence-v2.0.0/tests.lisp (12989 bytes)

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)))))