source: trunk/source/tests/ansi-tests/search-list.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 7.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Aug 24 07:22:10 2002
4;;;; Contains: Tests for SEARCH on lists
5
6(in-package :cl-test)
7
8(compile-and-load "search-aux.lsp")
9
10(deftest search-list.1
11  (let ((target *searched-list*)
12        (pat '(a)))
13    (loop for i from 0 to (1- (length target))
14          for tail on target
15          always
16          (let ((pos (search pat tail)))
17            (search-check pat tail pos))))
18  t)
19
20(deftest search-list.2
21  (let ((target *searched-list*)
22        (pat '(a)))
23    (loop for i from 1 to (length target)
24          always
25          (let ((pos (search pat target :end2 i :from-end t)))
26            (search-check pat target pos :end2 i :from-end t))))
27  t)
28
29(deftest search-list.3
30  (let ((target *searched-list*))
31    (loop for pat in *pattern-sublists*
32          for pos = (search pat target)
33          unless (search-check pat target pos)
34          collect pat))
35  nil)
36
37(deftest search-list.4
38  (let ((target *searched-list*))
39    (loop for pat in *pattern-sublists*
40          for pos = (search pat target :from-end t)
41          unless (search-check pat target pos :from-end t)
42          collect pat))
43  nil)
44
45(deftest search-list.5
46  (let ((target *searched-list*))
47    (loop for pat in *pattern-sublists*
48          for pos = (search pat target :start2 25 :end2 75)
49          unless (search-check pat target pos :start2 25 :end2 75)
50          collect pat))
51  nil)
52
53(deftest search-list.6
54  (let ((target *searched-list*))
55    (loop for pat in *pattern-sublists*
56          for pos = (search pat target :from-end t :start2 25 :end2 75)
57          unless (search-check pat target pos :from-end t
58                               :start2 25 :end2 75)
59          collect pat))
60  nil)
61
62(deftest search-list.7
63  (let ((target *searched-list*))
64    (loop for pat in *pattern-sublists*
65          for pos = (search pat target :start2 20)
66          unless (search-check pat target pos :start2 20)
67          collect pat))
68  nil)
69
70(deftest search-list.8
71  (let ((target *searched-list*))
72    (loop for pat in *pattern-sublists*
73          for pos = (search pat target :from-end t :start2 20)
74          unless (search-check pat target pos :from-end t
75                               :start2 20)
76          collect pat))
77  nil)
78
79(deftest search-list.9
80  (let ((target (sublis '((a . 1) (b . 2)) *searched-list*)))
81    (loop for pat in (sublis '((a . 3) (b . 4)) *pattern-sublists*)
82          for pos = (search pat target :start2 20 :key #'evenp)
83          unless (search-check pat target pos :start2 20 :key #'evenp)
84          collect pat))
85  nil)
86
87(deftest search-list.10
88  (let ((target (sublis '((a . 1) (b . 2)) *searched-list*)))
89    (loop for pat in (sublis '((a . 3) (b . 4)) *pattern-sublists*)
90          for pos = (search pat target :from-end t :start2 20 :key 'oddp)
91          unless (search-check pat target pos :from-end t
92                               :start2 20 :key 'oddp)
93          collect pat))
94  nil)
95
96(deftest search-list.11
97  (let ((target *searched-list*))
98    (loop for pat in *pattern-sublists*
99          for pos = (search pat target :start2 20 :test (complement #'eql))
100          unless (search-check pat target pos :start2 20
101                               :test (complement #'eql))
102          collect pat))
103  nil)
104
105(deftest search-list.12
106  (let ((target *searched-list*))
107    (loop for pat in *pattern-sublists*
108          for pos = (search pat target :from-end t :start2 20 :test-not #'eql)
109          unless (search-check pat target pos :from-end t
110                               :start2 20 :test (complement #'eql))
111          collect pat))
112  nil)
113
114(deftest search-list.13
115  (let ((target *searched-list*))
116    (loop for pat in *pattern-sublists*
117          when (and (> (length pat) 0)
118                    (let ((pos (search pat target :start1 1
119                                       :test (complement #'eql))))
120                      (not (search-check pat target pos
121                                         :start1 1
122                                         :test (complement #'eql)))))
123          collect pat))
124  nil)
125
126(deftest search-list.14
127  (let ((target *searched-list*))
128    (loop for pat in *pattern-sublists*
129          when (let ((len (length pat)))
130                 (and (> len 0)
131                      (let ((pos (search pat target :end1 (1- len)
132                                         :test (complement #'eql))))
133                      (not (search-check pat target pos
134                                         :end1 (1- len)
135                                         :test (complement #'eql))))))
136          collect pat))
137  nil)
138
139;; Order of test, test-not
140
141(deftest search-list.15
142  (let ((pat '(10))
143        (target '(1 4 6 10 15 20)))
144    (search pat target :test #'<))
145  4)
146
147(deftest search-list.16
148  (let ((pat '(10))
149        (target '(1 4 6 10 15 20)))
150    (search pat target :test-not #'>=))
151  4)
152
153(defharmless search.test-and-test-not.1
154  (search '(b c) '(a b c d) :test #'eql :test-not #'eql))
155
156(defharmless search.test-and-test-not.2
157  (search '(b c) '(a b c d) :test-not #'eql :test #'eql))
158
159(defharmless search.test-and-test-not.3
160  (search #(b c) #(a b c d) :test #'eql :test-not #'eql))
161
162(defharmless search.test-and-test-not.4
163  (search #(b c) #(a b c d) :test-not #'eql :test #'eql))
164
165(defharmless search.test-and-test-not.5
166  (search "bc" "abcd" :test #'eql :test-not #'eql))
167
168(defharmless search.test-and-test-not.6
169  (search "bc" "abcd" :test-not #'eql :test #'eql))
170
171(defharmless search.test-and-test-not.7
172  (search #*01 #*0011 :test #'eql :test-not #'eql))
173
174(defharmless search.test-and-test-not.8
175  (search #*01 #*0011 :test-not #'eql :test #'eql))
176
177
178;;; Keyword tests
179
180(deftest search.allow-other-keys.1
181  (search '(c d) '(a b c d c d e) :allow-other-keys t)
182  2)
183
184(deftest search.allow-other-keys.2
185  (search '(c d) '(a b c d c d e) :allow-other-keys nil)
186  2)
187
188(deftest search.allow-other-keys.3
189  (search '(c d) '(a b c d c d e) :bad t :allow-other-keys t)
190  2)
191
192(deftest search.allow-other-keys.4
193  (search '(c d) '(a b c d c d e) :allow-other-keys 'foo :bad nil)
194  2)
195
196(deftest search.allow-other-keys.5
197  (search '(c d) '(a b c d c d e) :bad1 1 :allow-other-keys t :bad2 2
198          :allow-other-keys nil :bad3 3)
199  2)
200
201(deftest search.allow-other-keys.6
202  (search '(c d) '(a b c d c d e) :allow-other-keys 'foo
203          :from-end t)
204  4)
205
206(deftest search.allow-other-keys.7
207  (search '(c d) '(a b c d c d e) :from-end t :allow-other-keys t)
208  4)
209
210(deftest search.keywords.8
211  (search '(c d) '(a b c d c d e) :start1 0 :start2 0 :start1 1
212          :start2 6 :from-end t :from-end nil)
213  4)
214
215
216;;; Error cases
217
218(deftest search.error.1
219  (signals-error (search) program-error)
220  t)
221
222(deftest search.error.2
223  (signals-error (search "a") program-error)
224  t)
225
226(deftest search.error.3
227  (signals-error (search "a" "a" :key) program-error)
228  t)
229
230(deftest search.error.4
231  (signals-error (search "a" "a" 'bad t) program-error)
232  t)
233
234(deftest search.error.5
235  (signals-error (search "a" "a" 'bad t :allow-other-keys nil) program-error)
236  t)
237
238(deftest search.error.6
239  (signals-error (search "a" "a" 1 2) program-error)
240  t)
241
242(deftest search.error.7
243  (signals-error (search "c" "abcde" :test #'identity) program-error)
244  t)
245
246(deftest search.error.8
247  (signals-error (search "c" "abcde" :test-not #'identity) program-error)
248  t)
249
250(deftest search.error.9
251  (signals-error (search "c" "abcde" :key #'cons) program-error)
252  t)
253
254(deftest search.error.10
255  (signals-error (search "c" "abcde" :key #'car) type-error)
256  t)
257
258;;; Order of evaluation
259
260(deftest search.order.1
261  (let ((i 0) a b c d e f g h j)
262    (values
263     (search
264      (progn (setf a (incf i)) '(nil a b nil))
265      (progn (setf b (incf i)) '(z z z a a b b z z z))
266      :from-end (progn (setf c (incf i)) t)
267      :start1 (progn (setf d (incf i)) 1)
268      :end1 (progn (setf e (incf i)) 3)
269      :start2 (progn (setf f (incf i)) 1)
270      :end2 (progn (setf g (incf i)) 8)
271      :key (progn (setf h (incf i)) #'identity)
272      :test (progn (setf j (incf i)) #'eql)
273      )
274     i a b c d e f g h j))
275  4 9 1 2 3 4 5 6 7 8 9)
276
277(deftest search.order.2
278  (let ((i 0) a b c d e f g h j)
279    (values
280     (search
281      (progn (setf a (incf i)) '(nil a b nil))
282      (progn (setf b (incf i)) '(z z z a a b b z z z))
283      :test-not (progn (setf c (incf i)) (complement #'eql))
284      :key (progn (setf d (incf i)) #'identity)
285      :end2 (progn (setf e (incf i)) 8)
286      :start2 (progn (setf f (incf i)) 1)
287      :end1 (progn (setf g (incf i)) 3)
288      :start1 (progn (setf h (incf i)) 1)
289      :from-end (progn (setf j (incf i)) t)
290      )
291     i a b c d e f g h j))
292  4 9 1 2 3 4 5 6 7 8 9)
Note: See TracBrowser for help on using the repository browser.