search-list.lsp 8.45 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Aug 24 07:22:10 2002
;;;; Contains: Tests for SEARCH on lists

(in-package :cl-test)

8 9
(compile-and-load "search-aux.lsp")

10 11
(deftest search-list.1
  (let ((target *searched-list*)
sds's avatar
sds committed
12
        (pat '(a)))
13
    (loop for i from 0 to (1- (length target))
sds's avatar
sds committed
14 15 16 17
          for tail on target
          always
          (let ((pos (search pat tail)))
            (search-check pat tail pos))))
18 19 20 21
  t)

(deftest search-list.2
  (let ((target *searched-list*)
sds's avatar
sds committed
22
        (pat '(a)))
23
    (loop for i from 1 to (length target)
sds's avatar
sds committed
24 25 26
          always
          (let ((pos (search pat target :end2 i :from-end t)))
            (search-check pat target pos :end2 i :from-end t))))
27 28 29 30 31
  t)

(deftest search-list.3
  (let ((target *searched-list*))
    (loop for pat in *pattern-sublists*
sds's avatar
sds committed
32 33 34
          for pos = (search pat target)
          unless (search-check pat target pos)
          collect pat))
35 36 37 38 39
  nil)

(deftest search-list.4
  (let ((target *searched-list*))
    (loop for pat in *pattern-sublists*
sds's avatar
sds committed
40 41 42
          for pos = (search pat target :from-end t)
          unless (search-check pat target pos :from-end t)
          collect pat))
43 44 45 46 47
  nil)

(deftest search-list.5
  (let ((target *searched-list*))
    (loop for pat in *pattern-sublists*
sds's avatar
sds committed
48 49 50
          for pos = (search pat target :start2 25 :end2 75)
          unless (search-check pat target pos :start2 25 :end2 75)
          collect pat))
51 52 53 54 55
  nil)

(deftest search-list.6
  (let ((target *searched-list*))
    (loop for pat in *pattern-sublists*
sds's avatar
sds committed
56 57 58 59
          for pos = (search pat target :from-end t :start2 25 :end2 75)
          unless (search-check pat target pos :from-end t
                               :start2 25 :end2 75)
          collect pat))
60 61 62 63 64
  nil)

(deftest search-list.7
  (let ((target *searched-list*))
    (loop for pat in *pattern-sublists*
sds's avatar
sds committed
65 66 67
          for pos = (search pat target :start2 20)
          unless (search-check pat target pos :start2 20)
          collect pat))
68 69 70 71 72
  nil)

(deftest search-list.8
  (let ((target *searched-list*))
    (loop for pat in *pattern-sublists*
sds's avatar
sds committed
73 74 75 76
          for pos = (search pat target :from-end t :start2 20)
          unless (search-check pat target pos :from-end t
                               :start2 20)
          collect pat))
77 78 79 80 81
  nil)

(deftest search-list.9
  (let ((target (sublis '((a . 1) (b . 2)) *searched-list*)))
    (loop for pat in (sublis '((a . 3) (b . 4)) *pattern-sublists*)
sds's avatar
sds committed
82 83 84
          for pos = (search pat target :start2 20 :key #'evenp)
          unless (search-check pat target pos :start2 20 :key #'evenp)
          collect pat))
85 86 87 88 89
  nil)

(deftest search-list.10
  (let ((target (sublis '((a . 1) (b . 2)) *searched-list*)))
    (loop for pat in (sublis '((a . 3) (b . 4)) *pattern-sublists*)
sds's avatar
sds committed
90 91 92 93
          for pos = (search pat target :from-end t :start2 20 :key 'oddp)
          unless (search-check pat target pos :from-end t
                               :start2 20 :key 'oddp)
          collect pat))
94 95 96 97 98
  nil)

(deftest search-list.11
  (let ((target *searched-list*))
    (loop for pat in *pattern-sublists*
sds's avatar
sds committed
99 100 101 102
          for pos = (search pat target :start2 20 :test (complement #'eql))
          unless (search-check pat target pos :start2 20
                               :test (complement #'eql))
          collect pat))
103 104 105 106 107
  nil)

(deftest search-list.12
  (let ((target *searched-list*))
    (loop for pat in *pattern-sublists*
sds's avatar
sds committed
108 109 110 111
          for pos = (search pat target :from-end t :start2 20 :test-not #'eql)
          unless (search-check pat target pos :from-end t
                               :start2 20 :test (complement #'eql))
          collect pat))
112 113 114 115 116
  nil)

(deftest search-list.13
  (let ((target *searched-list*))
    (loop for pat in *pattern-sublists*
sds's avatar
sds committed
117 118 119 120 121 122 123
          when (and (> (length pat) 0)
                    (let ((pos (search pat target :start1 1
                                       :test (complement #'eql))))
                      (not (search-check pat target pos
                                         :start1 1
                                         :test (complement #'eql)))))
          collect pat))
124 125 126 127 128
  nil)

(deftest search-list.14
  (let ((target *searched-list*))
    (loop for pat in *pattern-sublists*
sds's avatar
sds committed
129 130 131 132 133 134 135 136
          when (let ((len (length pat)))
                 (and (> len 0)
                      (let ((pos (search pat target :end1 (1- len)
                                         :test (complement #'eql))))
                      (not (search-check pat target pos
                                         :end1 (1- len)
                                         :test (complement #'eql))))))
          collect pat))
137 138
  nil)

139 140 141 142
;; Order of test, test-not

(deftest search-list.15
  (let ((pat '(10))
sds's avatar
sds committed
143
        (target '(1 4 6 10 15 20)))
144
    (search pat target :test #'<))
145 146 147 148
  4)

(deftest search-list.16
  (let ((pat '(10))
sds's avatar
sds committed
149
        (target '(1 4 6 10 15 20)))
150
    (search pat target :test-not #'>=))
151 152
  4)

153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
(defharmless search.test-and-test-not.1
  (search '(b c) '(a b c d) :test #'eql :test-not #'eql))

(defharmless search.test-and-test-not.2
  (search '(b c) '(a b c d) :test-not #'eql :test #'eql))

(defharmless search.test-and-test-not.3
  (search #(b c) #(a b c d) :test #'eql :test-not #'eql))

(defharmless search.test-and-test-not.4
  (search #(b c) #(a b c d) :test-not #'eql :test #'eql))

(defharmless search.test-and-test-not.5
  (search "bc" "abcd" :test #'eql :test-not #'eql))

(defharmless search.test-and-test-not.6
  (search "bc" "abcd" :test-not #'eql :test #'eql))

(defharmless search.test-and-test-not.7
  (search #*01 #*0011 :test #'eql :test-not #'eql))

(defharmless search.test-and-test-not.8
  (search #*01 #*0011 :test-not #'eql :test #'eql))

177

178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197
;;; Keyword tests

(deftest search.allow-other-keys.1
  (search '(c d) '(a b c d c d e) :allow-other-keys t)
  2)

(deftest search.allow-other-keys.2
  (search '(c d) '(a b c d c d e) :allow-other-keys nil)
  2)

(deftest search.allow-other-keys.3
  (search '(c d) '(a b c d c d e) :bad t :allow-other-keys t)
  2)

(deftest search.allow-other-keys.4
  (search '(c d) '(a b c d c d e) :allow-other-keys 'foo :bad nil)
  2)

(deftest search.allow-other-keys.5
  (search '(c d) '(a b c d c d e) :bad1 1 :allow-other-keys t :bad2 2
sds's avatar
sds committed
198
          :allow-other-keys nil :bad3 3)
199 200 201 202
  2)

(deftest search.allow-other-keys.6
  (search '(c d) '(a b c d c d e) :allow-other-keys 'foo
sds's avatar
sds committed
203
          :from-end t)
204 205 206 207 208 209 210 211
  4)

(deftest search.allow-other-keys.7
  (search '(c d) '(a b c d c d e) :from-end t :allow-other-keys t)
  4)

(deftest search.keywords.8
  (search '(c d) '(a b c d c d e) :start1 0 :start2 0 :start1 1
sds's avatar
sds committed
212
          :start2 6 :from-end t :from-end nil)
213 214 215
  4)


216 217 218
;;; Error cases

(deftest search.error.1
219 220
  (signals-error (search) program-error)
  t)
221 222

(deftest search.error.2
223 224
  (signals-error (search "a") program-error)
  t)
225 226

(deftest search.error.3
227 228
  (signals-error (search "a" "a" :key) program-error)
  t)
229 230

(deftest search.error.4
231 232
  (signals-error (search "a" "a" 'bad t) program-error)
  t)
233 234

(deftest search.error.5
235 236
  (signals-error (search "a" "a" 'bad t :allow-other-keys nil) program-error)
  t)
237 238

(deftest search.error.6
239 240
  (signals-error (search "a" "a" 1 2) program-error)
  t)
241

242
(deftest search.error.7
243 244
  (signals-error (search "c" "abcde" :test #'identity) program-error)
  t)
245 246

(deftest search.error.8
247 248
  (signals-error (search "c" "abcde" :test-not #'identity) program-error)
  t)
249 250

(deftest search.error.9
251 252
  (signals-error (search "c" "abcde" :key #'cons) program-error)
  t)
253 254

(deftest search.error.10
255 256
  (signals-error (search "c" "abcde" :key #'car) type-error)
  t)
257

258 259 260 261 262 263 264 265 266 267 268 269 270 271
;;; Order of evaluation

(deftest search.order.1
  (let ((i 0) a b c d e f g h j)
    (values
     (search
      (progn (setf a (incf i)) '(nil a b nil))
      (progn (setf b (incf i)) '(z z z a a b b z z z))
      :from-end (progn (setf c (incf i)) t)
      :start1 (progn (setf d (incf i)) 1)
      :end1 (progn (setf e (incf i)) 3)
      :start2 (progn (setf f (incf i)) 1)
      :end2 (progn (setf g (incf i)) 8)
      :key (progn (setf h (incf i)) #'identity)
272
      :test (progn (setf j (incf i)) #'eql)
273 274 275 276 277 278 279 280 281 282
      )
     i a b c d e f g h j))
  4 9 1 2 3 4 5 6 7 8 9)

(deftest search.order.2
  (let ((i 0) a b c d e f g h j)
    (values
     (search
      (progn (setf a (incf i)) '(nil a b nil))
      (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 285 286 287 288 289 290 291
      :key (progn (setf d (incf i)) #'identity)
      :end2 (progn (setf e (incf i)) 8)
      :start2 (progn (setf f (incf i)) 1)
      :end1 (progn (setf g (incf i)) 3)
      :start1 (progn (setf h (incf i)) 1)
      :from-end (progn (setf j (incf i)) t)
      )
     i a b c d e f g h j))
sds's avatar
sds committed
292
  4 9 1 2 3 4 5 6 7 8 9)