Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

substitute-if-not.lsp @ 8991

Visit:

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago
Check in the gcl ansi test suite (original, in preparation for making local changes)
File size: 26.7 KB

Line
1	;-- Mode: Lisp --
2	;;;; Author: Paul Dietz
3	;;;; Created: Sat Aug 31 18:17:09 2002
4	;;;; Contains: Tests for SUBSTITUTE-IF-NOT
5
6	(in-package :cl-test)
7
8	(deftest substitute-if-not-list.1
9	(let ((x '())) (values (substitute-if-not 'b #'null x) x))
10	nil nil)
11
12	(deftest substitute-if-not-list.2
13	(let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x) x))
14	(b b b c)
15	(a b a c))
16
17	(deftest substitute-if-not-list.3
18	(let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count nil) x))
19	(b b b c)
20	(a b a c))
21
22	(deftest substitute-if-not-list.4
23	(let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 2) x))
24	(b b b c)
25	(a b a c))
26
27	(deftest substitute-if-not-list.5
28	(let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 1) x))
29	(b b a c)
30	(a b a c))
31
32	(deftest substitute-if-not-list.6
33	(let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 0) x))
34	(a b a c)
35	(a b a c))
36
37	(deftest substitute-if-not-list.7
38	(let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count -1) x))
39	(a b a c)
40	(a b a c))
41
42	(deftest substitute-if-not-list.8
43	(let ((x '())) (values (substitute-if-not 'b (is-not-eql-p 'a) x :from-end t) x))
44	nil nil)
45
46	(deftest substitute-if-not-list.9
47	(let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :from-end t) x))
48	(b b b c)
49	(a b a c))
50
51	(deftest substitute-if-not-list.10
52	(let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :from-end t :count nil) x))
53	(b b b c)
54	(a b a c))
55
56	(deftest substitute-if-not-list.11
57	(let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 2 :from-end t) x))
58	(b b b c)
59	(a b a c))
60
61	(deftest substitute-if-not-list.12
62	(let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 1 :from-end t) x))
63	(a b b c)
64	(a b a c))
65
66	(deftest substitute-if-not-list.13
67	(let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 0 :from-end t) x))
68	(a b a c)
69	(a b a c))
70
71	(deftest substitute-if-not-list.14
72	(let ((x '(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count -1 :from-end t) x))
73	(a b a c)
74	(a b a c))
75
76	(deftest substitute-if-not-list.15
77	(loop for i from 0 to 9 always
78	(loop for j from i to 10 always
79	(let* ((orig '(a a a a a a a a a a))
80	(x (copy-seq orig))
81	(y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j)))
82	(and (equal orig x)
83	(equal y (nconc (make-list i :initial-element 'a)
84	(make-list (- j i) :initial-element 'x)
85	(make-list (- 10 j) :initial-element 'a)))))))
86	t)
87
88	(deftest substitute-if-not-list.16
89	(loop for i from 0 to 9 always
90	(loop for j from i to 10 always
91	(let* ((orig '(a a a a a a a a a a))
92	(x (copy-seq orig))
93	(y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :from-end t)))
94	(and (equal orig x)
95	(equal y (nconc (make-list i :initial-element 'a)
96	(make-list (- j i) :initial-element 'x)
97	(make-list (- 10 j) :initial-element 'a)))))))
98	t)
99
100	(deftest substitute-if-not-list.17
101	(loop for i from 0 to 9 always
102	(loop for j from i to 10 always
103	(loop for c from 0 to (- j i) always
104	(let* ((orig '(a a a a a a a a a a))
105	(x (copy-seq orig))
106	(y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c)))
107	(and (equal orig x)
108	(equal y (nconc (make-list i :initial-element 'a)
109	(make-list c :initial-element 'x)
110	(make-list (- 10 (+ i c)) :initial-element 'a))))))))
111	t)
112
113	(deftest substitute-if-not-list.18
114	(loop for i from 0 to 9 always
115	(loop for j from i to 10 always
116	(loop for c from 0 to (- j i) always
117	(let* ((orig '(a a a a a a a a a a))
118	(x (copy-seq orig))
119	(y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c :from-end t)))
120	(and (equal orig x)
121	(equal y (nconc (make-list (- j c) :initial-element 'a)
122	(make-list c :initial-element 'x)
123	(make-list (- 10 j) :initial-element 'a))))))))
124	t)
125
126	;;; Tests on vectors
127
128	(deftest substitute-if-not-vector.1
129	(let ((x #())) (values (substitute-if-not 'b (is-not-eql-p 'a) x) x))
130	#() #())
131
132	(deftest substitute-if-not-vector.2
133	(let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x) x))
134	#(b b b c)
135	#(a b a c))
136
137	(deftest substitute-if-not-vector.3
138	(let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count nil) x))
139	#(b b b c)
140	#(a b a c))
141
142	(deftest substitute-if-not-vector.4
143	(let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 2) x))
144	#(b b b c)
145	#(a b a c))
146
147	(deftest substitute-if-not-vector.5
148	(let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 1) x))
149	#(b b a c)
150	#(a b a c))
151
152	(deftest substitute-if-not-vector.6
153	(let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 0) x))
154	#(a b a c)
155	#(a b a c))
156
157	(deftest substitute-if-not-vector.7
158	(let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count -1) x))
159	#(a b a c)
160	#(a b a c))
161
162	(deftest substitute-if-not-vector.8
163	(let ((x #())) (values (substitute-if-not 'b (is-not-eql-p 'a) x :from-end t) x))
164	#() #())
165
166	(deftest substitute-if-not-vector.9
167	(let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :from-end t) x))
168	#(b b b c)
169	#(a b a c))
170
171	(deftest substitute-if-not-vector.10
172	(let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :from-end t :count nil) x))
173	#(b b b c)
174	#(a b a c))
175
176	(deftest substitute-if-not-vector.11
177	(let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 2 :from-end t) x))
178	#(b b b c)
179	#(a b a c))
180
181	(deftest substitute-if-not-vector.12
182	(let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 1 :from-end t) x))
183	#(a b b c)
184	#(a b a c))
185
186	(deftest substitute-if-not-vector.13
187	(let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count 0 :from-end t) x))
188	#(a b a c)
189	#(a b a c))
190
191	(deftest substitute-if-not-vector.14
192	(let ((x #(a b a c))) (values (substitute-if-not 'b (is-not-eql-p 'a) x :count -1 :from-end t) x))
193	#(a b a c)
194	#(a b a c))
195
196	(deftest substitute-if-not-vector.15
197	(loop for i from 0 to 9 always
198	(loop for j from i to 10 always
199	(let* ((orig #(a a a a a a a a a a))
200	(x (copy-seq orig))
201	(y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j)))
202	(and (equalp orig x)
203	(equalp y (concatenate 'simple-vector
204	(make-array i :initial-element 'a)
205	(make-array (- j i) :initial-element 'x)
206	(make-array (- 10 j) :initial-element 'a)))))))
207	t)
208
209	(deftest substitute-if-not-vector.16
210	(loop for i from 0 to 9 always
211	(loop for j from i to 10 always
212	(let* ((orig #(a a a a a a a a a a))
213	(x (copy-seq orig))
214	(y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :from-end t)))
215	(and (equalp orig x)
216	(equalp y (concatenate 'simple-vector
217	(make-array i :initial-element 'a)
218	(make-array (- j i) :initial-element 'x)
219	(make-array (- 10 j) :initial-element 'a)))))))
220	t)
221
222	(deftest substitute-if-not-vector.17
223	(loop for i from 0 to 9 always
224	(loop for j from i to 10 always
225	(loop for c from 0 to (- j i) always
226	(let* ((orig #(a a a a a a a a a a))
227	(x (copy-seq orig))
228	(y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c)))
229	(and (equalp orig x)
230	(equalp y (concatenate 'simple-vector
231	(make-array i :initial-element 'a)
232	(make-array c :initial-element 'x)
233	(make-array (- 10 (+ i c)) :initial-element 'a))))))))
234	t)
235
236	(deftest substitute-if-not-vector.18
237	(loop for i from 0 to 9 always
238	(loop for j from i to 10 always
239	(loop for c from 0 to (- j i) always
240	(let* ((orig #(a a a a a a a a a a))
241	(x (copy-seq orig))
242	(y (substitute-if-not 'x (is-not-eql-p 'a) x :start i :end j :count c :from-end t)))
243	(and (equalp orig x)
244	(equalp y (concatenate 'simple-vector
245	(make-array (- j c) :initial-element 'a)
246	(make-array c :initial-element 'x)
247	(make-array (- 10 j) :initial-element 'a))))))))
248	t)
249
250	(deftest substitute-if-not-vector.28
251	(let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
252	:fill-pointer 5))
253	(result (substitute-if-not 'z (is-not-eql-p 'a) x)))
254	result)
255	#(z b z c b))
256
257	(deftest substitute-if-not-vector.29
258	(let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
259	:fill-pointer 5))
260	(result (substitute-if-not 'z (is-not-eql-p 'a) x :from-end t)))
261	result)
262	#(z b z c b))
263
264	(deftest substitute-if-not-vector.30
265	(let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
266	:fill-pointer 5))
267	(result (substitute-if-not 'z (is-not-eql-p 'a) x :count 1)))
268	result)
269	#(z b a c b))
270
271	(deftest substitute-if-not-vector.31
272	(let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
273	:fill-pointer 5))
274	(result (substitute-if-not 'z (is-not-eql-p 'a) x
275	:from-end t :count 1)))
276	result)
277	#(a b z c b))
278
279	(deftest substitute-if-not-vector.32
280	(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
281	(v2 (make-array '(8) :displaced-to v1
282	:displaced-index-offset 3)))
283	(values
284	(substitute-if-not 'x (is-not-eql-p 'c) v2 :count 1)
285	v1))
286	#(d a b x d a b c)
287	#(a b c d a b c d a b c d a b c d))
288
289	(deftest substitute-if-not-vector.33
290	(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
291	(v2 (make-array '(8) :displaced-to v1
292	:displaced-index-offset 3)))
293	(values
294	(substitute-if-not 'x (is-not-eql-p 'c) v2 :count 1 :from-end t)
295	v1))
296	#(d a b c d a b x)
297	#(a b c d a b c d a b c d a b c d))
298
299
300
301	;;; Tests on strings
302
303	(deftest substitute-if-not-string.1
304	(let ((x "")) (values (substitute-if-not #\b (is-not-eql-p #\a) x) x))
305	"" "")
306
307	(deftest substitute-if-not-string.2
308	(let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x) x))
309	"bbbc"
310	"abac")
311
312	(deftest substitute-if-not-string.3
313	(let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count nil) x))
314	"bbbc"
315	"abac")
316
317	(deftest substitute-if-not-string.4
318	(let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 2) x))
319	"bbbc"
320	"abac")
321
322	(deftest substitute-if-not-string.5
323	(let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 1) x))
324	"bbac"
325	"abac")
326
327	(deftest substitute-if-not-string.6
328	(let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 0) x))
329	"abac"
330	"abac")
331
332	(deftest substitute-if-not-string.7
333	(let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count -1) x))
334	"abac"
335	"abac")
336
337	(deftest substitute-if-not-string.8
338	(let ((x "")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :from-end t) x))
339	"" "")
340
341	(deftest substitute-if-not-string.9
342	(let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :from-end t) x))
343	"bbbc"
344	"abac")
345
346	(deftest substitute-if-not-string.10
347	(let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :from-end t :count nil) x))
348	"bbbc"
349	"abac")
350
351	(deftest substitute-if-not-string.11
352	(let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 2 :from-end t) x))
353	"bbbc"
354	"abac")
355
356	(deftest substitute-if-not-string.12
357	(let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 1 :from-end t) x))
358	"abbc"
359	"abac")
360
361	(deftest substitute-if-not-string.13
362	(let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count 0 :from-end t) x))
363	"abac"
364	"abac")
365
366	(deftest substitute-if-not-string.14
367	(let ((x "abac")) (values (substitute-if-not #\b (is-not-eql-p #\a) x :count -1 :from-end t) x))
368	"abac"
369	"abac")
370
371	(deftest substitute-if-not-string.15
372	(loop for i from 0 to 9 always
373	(loop for j from i to 10 always
374	(let* ((orig "aaaaaaaaaa")
375	(x (copy-seq orig))
376	(y (substitute-if-not #\x (is-not-eql-p #\a) x :start i :end j)))
377	(and (equalp orig x)
378	(equalp y (concatenate 'simple-string
379	(make-array i :initial-element #\a)
380	(make-array (- j i) :initial-element #\x)
381	(make-array (- 10 j) :initial-element #\a)))))))
382	t)
383
384	(deftest substitute-if-not-string.16
385	(loop for i from 0 to 9 always
386	(loop for j from i to 10 always
387	(let* ((orig "aaaaaaaaaa")
388	(x (copy-seq orig))
389	(y (substitute-if-not #\x (is-not-eql-p #\a) x :start i :end j :from-end t)))
390	(and (equalp orig x)
391	(equalp y (concatenate 'simple-string
392	(make-array i :initial-element #\a)
393	(make-array (- j i) :initial-element #\x)
394	(make-array (- 10 j) :initial-element #\a)))))))
395	t)
396
397	(deftest substitute-if-not-string.17
398	(loop for i from 0 to 9 always
399	(loop for j from i to 10 always
400	(loop for c from 0 to (- j i) always
401	(let* ((orig "aaaaaaaaaa")
402	(x (copy-seq orig))
403	(y (substitute-if-not #\x (is-not-eql-p #\a) x :start i :end j :count c)))
404	(and (equalp orig x)
405	(equalp y (concatenate 'simple-string
406	(make-array i :initial-element #\a)
407	(make-array c :initial-element #\x)
408	(make-array (- 10 (+ i c)) :initial-element #\a))))))))
409	t)
410
411	(deftest substitute-if-not-string.18
412	(loop for i from 0 to 9 always
413	(loop for j from i to 10 always
414	(loop for c from 0 to (- j i) always
415	(let* ((orig "aaaaaaaaaa")
416	(x (copy-seq orig))
417	(y (substitute-if-not #\x (is-not-eql-p #\a) x :start i :end j :count c :from-end t)))
418	(and (equalp orig x)
419	(equalp y (concatenate 'simple-string
420	(make-array (- j c) :initial-element #\a)
421	(make-array c :initial-element #\x)
422	(make-array (- 10 j) :initial-element #\a))))))))
423	t)
424
425	(deftest substitute-if-not-string.28
426	(let* ((x (make-array '(10) :initial-contents "abacbadeaf"
427	:fill-pointer 5 :element-type 'character))
428	(result (substitute-if-not #\z (is-not-eql-p #\a) x)))
429	result)
430	"zbzcb")
431
432	(deftest substitute-if-not-string.29
433	(let* ((x (make-array '(10) :initial-contents "abacbadeaf"
434	:fill-pointer 5 :element-type 'character))
435	(result (substitute-if-not #\z (is-not-eql-p #\a) x :from-end t)))
436	result)
437	"zbzcb")
438
439	(deftest substitute-if-not-string.30
440	(let* ((x (make-array '(10) :initial-contents "abacbadeaf"
441	:fill-pointer 5 :element-type 'character))
442	(result (substitute-if-not #\z (is-not-eql-p #\a) x :count 1)))
443	result)
444	"zbacb")
445
446	(deftest substitute-if-not-string.31
447	(let* ((x (make-array '(10) :initial-contents "abacbadeaf"
448	:fill-pointer 5 :element-type 'character))
449	(result (substitute-if-not #\z (is-not-eql-p #\a) x
450	:from-end t :count 1)))
451	result)
452	"abzcb")
453
454
455
456	;;; Tests on bitstrings
457
458	(deftest substitute-if-not-bitstring.1
459	(let* ((orig #*)
460	(x (copy-seq orig))
461	(result (substitute-if-not 0 (is-not-eql-p 1) x)))
462	(and (equalp orig x)
463	result))
464	#*)
465
466	(deftest substitute-if-not-bitstring.2
467	(let* ((orig #*)
468	(x (copy-seq orig))
469	(result (substitute-if-not 1 (complement #'zerop) x)))
470	(and (equalp orig x)
471	result))
472	#*)
473
474	(deftest substitute-if-not-bitstring.3
475	(let* ((orig #*010101)
476	(x (copy-seq orig))
477	(result (substitute-if-not 0 (is-not-eql-p 1) x)))
478	(and (equalp orig x)
479	result))
480	#*000000)
481
482	(deftest substitute-if-not-bitstring.4
483	(let* ((orig #*010101)
484	(x (copy-seq orig))
485	(result (substitute-if-not 1 (complement #'zerop) x)))
486	(and (equalp orig x)
487	result))
488	#*111111)
489
490	(deftest substitute-if-not-bitstring.5
491	(let* ((orig #*010101)
492	(x (copy-seq orig))
493	(result (substitute-if-not 1 (complement #'zerop) x :start 1)))
494	(and (equalp orig x)
495	result))
496	#*011111)
497
498	(deftest substitute-if-not-bitstring.6
499	(let* ((orig #*010101)
500	(x (copy-seq orig))
501	(result (substitute-if-not 0 (is-not-eql-p 1) x :start 2 :end nil)))
502	(and (equalp orig x)
503	result))
504	#*010000)
505
506	(deftest substitute-if-not-bitstring.7
507	(let* ((orig #*010101)
508	(x (copy-seq orig))
509	(result (substitute-if-not 1 (complement #'zerop) x :end 4)))
510	(and (equalp orig x)
511	result))
512	#*111101)
513
514	(deftest substitute-if-not-bitstring.8
515	(let* ((orig #*010101)
516	(x (copy-seq orig))
517	(result (substitute-if-not 0 (is-not-eql-p 1) x :end nil)))
518	(and (equalp orig x)
519	result))
520	#*000000)
521
522	(deftest substitute-if-not-bitstring.9
523	(let* ((orig #*010101)
524	(x (copy-seq orig))
525	(result (substitute-if-not 0 (is-not-eql-p 1) x :end 3)))
526	(and (equalp orig x)
527	result))
528	#*000101)
529
530	(deftest substitute-if-not-bitstring.10
531	(let* ((orig #*010101)
532	(x (copy-seq orig))
533	(result (substitute-if-not 0 (is-not-eql-p 1) x :start 2 :end 4)))
534	(and (equalp orig x)
535	result))
536	#*010001)
537
538	(deftest substitute-if-not-bitstring.11
539	(let* ((orig #*010101)
540	(x (copy-seq orig))
541	(result (substitute-if-not 1 (complement #'zerop) x :start 2 :end 4)))
542	(and (equalp orig x)
543	result))
544	#*011101)
545
546	(deftest substitute-if-not-bitstring.12
547	(let* ((orig #*010101)
548	(x (copy-seq orig))
549	(result (substitute-if-not 1 (complement #'zerop) x :count 1)))
550	(and (equalp orig x)
551	result))
552	#*110101)
553
554	(deftest substitute-if-not-bitstring.13
555	(let* ((orig #*010101)
556	(x (copy-seq orig))
557	(result (substitute-if-not 1 (complement #'zerop) x :count 0)))
558	(and (equalp orig x)
559	result))
560	#*010101)
561
562	(deftest substitute-if-not-bitstring.14
563	(let* ((orig #*010101)
564	(x (copy-seq orig))
565	(result (substitute-if-not 1 (complement #'zerop) x :count -1)))
566	(and (equalp orig x)
567	result))
568	#*010101)
569
570	(deftest substitute-if-not-bitstring.15
571	(let* ((orig #*010101)
572	(x (copy-seq orig))
573	(result (substitute-if-not 1 (complement #'zerop) x :count 1 :from-end t)))
574	(and (equalp orig x)
575	result))
576	#*010111)
577
578	(deftest substitute-if-not-bitstring.16
579	(let* ((orig #*010101)
580	(x (copy-seq orig))
581	(result (substitute-if-not 1 (complement #'zerop) x :count 0 :from-end t)))
582	(and (equalp orig x)
583	result))
584	#*010101)
585
586	(deftest substitute-if-not-bitstring.17
587	(let* ((orig #*010101)
588	(x (copy-seq orig))
589	(result (substitute-if-not 1 (complement #'zerop) x :count -1 :from-end t)))
590	(and (equalp orig x)
591	result))
592	#*010101)
593
594	(deftest substitute-if-not-bitstring.18
595	(let* ((orig #*010101)
596	(x (copy-seq orig))
597	(result (substitute-if-not 1 (complement #'zerop) x :count nil)))
598	(and (equalp orig x)
599	result))
600	#*111111)
601
602	(deftest substitute-if-not-bitstring.19
603	(let* ((orig #*010101)
604	(x (copy-seq orig))
605	(result (substitute-if-not 1 (complement #'zerop) x :count nil :from-end t)))
606	(and (equalp orig x)
607	result))
608	#*111111)
609
610	(deftest substitute-if-not-bitstring.20
611	(loop for i from 0 to 9 always
612	(loop for j from i to 10 always
613	(loop for c from 0 to (- j i) always
614	(let* ((orig #*0000000000)
615	(x (copy-seq orig))
616	(y (substitute-if-not 1 (complement #'zerop) x :start i :end j :count c)))
617	(and (equalp orig x)
618	(equalp y (concatenate
619	'simple-bit-vector
620	(make-list i :initial-element 0)
621	(make-list c :initial-element 1)
622	(make-list (- 10 (+ i c)) :initial-element 0))))))))
623	t)
624
625	(deftest substitute-if-not-bitstring.21
626	(loop for i from 0 to 9 always
627	(loop for j from i to 10 always
628	(loop for c from 0 to (- j i) always
629	(let* ((orig #*1111111111)
630	(x (copy-seq orig))
631	(y (substitute-if-not 0 (is-not-eql-p 1) x :start i :end j :count c :from-end t)))
632	(and (equalp orig x)
633	(equalp y (concatenate
634	'simple-bit-vector
635	(make-list (- j c) :initial-element 1)
636	(make-list c :initial-element 0)
637	(make-list (- 10 j) :initial-element 1))))))))
638	t)
639
640	;;; More tests
641
642	(deftest substitute-if-not-list.24
643	(let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
644	(x (copy-seq orig))
645	(result (substitute-if-not '(a 10) (is-not-eql-p 'a) x :key #'car)))
646	(and (equal orig x)
647	result))
648	((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))
649
650	(deftest substitute-if-not-list.25
651	(let* ((orig '((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
652	(x (copy-seq orig))
653	(result (substitute-if-not '(a 10) (is-not-eql-p 'a) x
654	:key #'car :start 1 :end 5)))
655	(and (equal orig x)
656	result))
657	((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7)))
658
659	(deftest substitute-if-not-vector.24
660	(let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
661	(x (copy-seq orig))
662	(result (substitute-if-not '(a 10) (is-not-eql-p 'a) x :key #'car)))
663	(and (equalp orig x)
664	result))
665	#((a 10) (b 2) (a 10) (c 4) (d 5) (a 10) (e 7)))
666
667	(deftest substitute-if-not-vector.25
668	(let* ((orig #((a 1) (b 2) (a 3) (c 4) (d 5) (a 6) (e 7)))
669	(x (copy-seq orig))
670	(result (substitute-if-not '(a 10) (is-not-eql-p 'a) x :key #'car :start 1 :end 5)))
671	(and (equalp orig x)
672	result))
673	#((a 1) (b 2) (a 10) (c 4) (d 5) (a 6) (e 7)))
674
675	(deftest substitute-if-not-string.24
676	(let* ((orig "0102342015")
677	(x (copy-seq orig))
678	(result (substitute-if-not #\a (is-not-eql-p #\1) x :key #'nextdigit)))
679	(and (equalp orig x)
680	result))
681	"a1a2342a15")
682
683	(deftest substitute-if-not-string.25
684	(let* ((orig "0102342015")
685	(x (copy-seq orig))
686	(result (substitute-if-not #\a (is-not-eql-p #\1) x :key #'nextdigit :start 1 :end 6)))
687	(and (equalp orig x)
688	result))
689	"01a2342015")
690
691	(deftest substitute-if-not-string.26
692	(do-special-strings
693	(s "xyzabcxyzabc" nil)
694	(assert (string= (substitute-if-not #\! (is-not-eql-p #\a) s) "xyz!bcxyz!bc"))
695	(assert (string= (substitute-if-not #\! (is-not-eql-p #\a) s :count 1) "xyz!bcxyzabc"))
696	(assert (string= (substitute-if-not #\! (is-not-eql-p #\a) s :count 1 :from-end t) "xyzabcxyz!bc"))
697	(assert (string= s "xyzabcxyzabc")))
698	nil)
699
700	(deftest substitute-if-not-bitstring.26
701	(let* ((orig #*00111001011010110)
702	(x (copy-seq orig))
703	(result (substitute-if-not 1 (is-not-eql-p 1) x :key #'1+)))
704	(and (equalp orig x)
705	result))
706	#*11111111111111111)
707
708	(deftest substitute-if-not-bitstring.27
709	(let* ((orig #*00111001011010110)
710	(x (copy-seq orig))
711	(result (substitute-if-not 1 (is-not-eql-p 1) x :key #'1+ :start 1 :end 10)))
712	(and (equalp orig x)
713	result))
714	#*01111111111010110)
715
716	(deftest substitute-if-not-bit-vector.30
717	(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
718	:fill-pointer 5 :element-type 'bit))
719	(result (substitute-if-not 1 #'onep x)))
720	result)
721	#*11111)
722
723	(deftest substitute-if-not-bit-vector.31
724	(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
725	:fill-pointer 5 :element-type 'bit))
726	(result (substitute-if-not 1 #'onep x :from-end t)))
727	result)
728	#*11111)
729
730	(deftest substitute-if-not-bit-vector.32
731	(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
732	:fill-pointer 5 :element-type 'bit))
733	(result (substitute-if-not 1 #'onep x :count 1)))
734	result)
735	#*11011)
736
737	(deftest substitute-if-not-bit-vector.33
738	(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
739	:fill-pointer 5 :element-type 'bit))
740	(result (substitute-if-not 1 #'onep x :from-end t :count 1)))
741	result)
742	#*01111)
743
744	(deftest substitute-if-not.order.1
745	(let ((i 0) a b c d e f g h)
746	(values
747	(substitute-if-not
748	(progn (setf a (incf i)) 'a)
749	(progn (setf b (incf i)) #'identity)
750	(progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5))
751	:count (progn (setf d (incf i)) 2)
752	:start (progn (setf e (incf i)) 0)
753	:end (progn (setf f (incf i)) 7)
754	:key (progn (setf g (incf i)) #'identity)
755	:from-end (setf h (incf i))
756	)
757	i a b c d e f g h))
758	(nil 1 2 a 3 4 a 5)
759	8 1 2 3 4 5 6 7 8)
760
761	(deftest substitute-if-not.order.2
762	(let ((i 0) a b c d e f g h)
763	(values
764	(substitute-if-not
765	(progn (setf a (incf i)) 'a)
766	(progn (setf b (incf i)) #'identity)
767	(progn (setf c (incf i)) (list nil 1 2 nil 3 4 nil 5))
768	:from-end (setf h (incf i))
769	:key (progn (setf g (incf i)) #'identity)
770	:end (progn (setf f (incf i)) 7)
771	:start (progn (setf e (incf i)) 0)
772	:count (progn (setf d (incf i)) 2)
773	)
774	i a b c d e f g h))
775	(nil 1 2 a 3 4 a 5)
776	8 1 2 3 8 7 6 5 4)
777
778	;;; Keyword tests
779
780	(deftest substitute-if-not.allow-other-keys.1
781	(substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
782	:allow-other-keys t :bad t)
783	(a a 0 a a 0 a))
784
785	(deftest substitute-if-not.allow-other-keys.2
786	(substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
787	:bad t :allow-other-keys t)
788	(a a 0 a a 0 a))
789
790	(deftest substitute-if-not.allow-other-keys.3
791	(substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t
792	:allow-other-keys nil :bad t)
793	(a a 0 a a 0 a))
794
795	(deftest substitute-if-not.allow-other-keys.4
796	(substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :bad t
797	:allow-other-keys t :allow-other-keys nil)
798	(a a 0 a a 0 a))
799
800	(deftest substitute-if-not.allow-other-keys.5
801	(substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
802	:allow-other-keys t :key #'1-)
803	(1 a a a 1 a a))
804
805	(deftest substitute-if-not.keywords.6
806	(substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3)
807	:key #'1- :key #'identity)
808	(1 a a a 1 a a))
809
810	(deftest substitute-if-not.allow-other-keys.7
811	(substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys t
812	:bad t :allow-other-keys nil)
813	(a a 0 a a 0 a))
814
815	(deftest substitute-if-not.allow-other-keys.8
816	(substitute-if-not 'a #'zerop (list 1 2 0 3 1 0 3) :allow-other-keys nil)
817	(a a 0 a a 0 a))
818
819	;;; Constant folding tests
820
821	(def-fold-test substitute-if-not.fold.1
822	(substitute-if-not 'z 'identity '(a nil b)))
823	(def-fold-test substitute-if-not.fold.2
824	(substitute-if-not 'z 'identity #(a nil b)))
825	(def-fold-test substitute-if-not.fold.3
826	(substitute-if-not 0 'zerop #*100110))
827	(def-fold-test substitute-if-not.fold.4
828	(substitute-if-not #\0 #'digit-char-p "asdaw82213nn1239123dd"))
829
830	;;; Error cases
831
832	(deftest substitute-if-not.error.1
833	(signals-error (substitute-if-not) program-error)
834	t)
835
836	(deftest substitute-if-not.error.2
837	(signals-error (substitute-if-not 'a) program-error)
838	t)
839
840	(deftest substitute-if-not.error.3
841	(signals-error (substitute-if-not 'a #'null) program-error)
842	t)
843
844	(deftest substitute-if-not.error.4
845	(signals-error (substitute-if-not 'a #'null nil 'bad t) program-error)
846	t)
847
848	(deftest substitute-if-not.error.5
849	(signals-error (substitute-if-not 'a #'null nil
850	'bad t :allow-other-keys nil) program-error)
851	t)
852
853	(deftest substitute-if-not.error.6
854	(signals-error (substitute-if-not 'a #'null nil :key) program-error)
855	t)
856
857	(deftest substitute-if-not.error.7
858	(signals-error (substitute-if-not 'a #'null nil 1 2) program-error)
859	t)
860
861	(deftest substitute-if-not.error.8
862	(signals-error (substitute-if-not 'a #'cons (list 'a 'b 'c)) program-error)
863	t)
864
865	(deftest substitute-if-not.error.9
866	(signals-error (substitute-if-not 'a #'car (list 'a 'b 'c)) type-error)
867	t)
868
869	(deftest substitute-if-not.error.10
870	(signals-error (substitute-if-not 'a #'identity (list 'a 'b 'c)
871	:key #'car)
872	type-error)
873	t)
874
875	(deftest substitute-if-not.error.11
876	(signals-error (substitute-if-not 'a #'identity (list 'a 'b 'c)
877	:key #'cons)
878	program-error)
879	t)
880
881	(deftest substitute-if-not.error.12
882	(check-type-error #'(lambda (x) (substitute-if-not 'a #'not x)) #'sequencep)
883	nil)

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format