← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/search-list.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/search-list.lsp
 
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)
 
 
b'\\ No newline at end of file'