position.lsp 20.8 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Aug 23 07:49:49 2002
;;;; Contains: Tests for POSITION

(in-package :cl-test)

(deftest position-list.1
  (position 'c '(a b c d e c a))
  2)

(deftest position-list.2
  (position 'c '(a b c d e c a) :from-end t)
  5)

(deftest position-list.3
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
18
        (position 'c '(a b c d e c a) :start i))
19 20 21 22
  (2 2 2 5 5 5 nil nil))

(deftest position-list.4
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
23
        (position 'c '(a b c d e c a) :start i :end nil))
24 25 26 27
  (2 2 2 5 5 5 nil nil))

(deftest position-list.5
  (loop for i from 7 downto 0 collect
sds's avatar
sds committed
28
        (position 'c '(a b c d e c a) :end i))
29 30 31 32
  (2 2 2 2 2 nil nil nil))

(deftest position-list.6
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
33
        (position 'c '(a b c d e c a) :start i :from-end t))
34 35 36 37
  (5 5 5 5 5 5 nil nil))

(deftest position-list.7
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
38
        (position 'c '(a b c d e c a) :start i :end nil :from-end t))
39 40 41 42
  (5 5 5 5 5 5 nil nil))

(deftest position-list.8
  (loop for i from 7 downto 0 collect
sds's avatar
sds committed
43
        (position 'c '(a b c d e c a) :end i :from-end t))
44 45 46 47
  (5 5 2 2 2 nil nil nil))

(deftest position-list.9
  (loop for i from 0 to 6 collect
sds's avatar
sds committed
48 49 50
        (loop for j from (1+ i) to 7
              collect
              (position 'c '(a b c d e c a) :start i :end j)))
51 52 53 54 55 56 57 58 59 60
  ((nil nil 2 2 2 2 2)
   (nil 2 2 2 2 2)
   (2 2 2 2 2)
   (nil nil 5 5)
   (nil 5 5)
   (5 5)
   (nil)))

(deftest position-list.10
  (loop for i from 0 to 6 collect
sds's avatar
sds committed
61 62 63
        (loop for j from (1+ i) to 7
              collect
              (position 'c '(a b c d e c a) :start i :end j :from-end t)))
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
  ((nil nil 2 2 2 5 5)
   (nil 2 2 2 5 5)
   (2 2 2 5 5)
   (nil nil 5 5)
   (nil 5 5)
   (5 5)
   (nil)))

(deftest position-list.11
  (position 5 '(1 2 3 4 5 6 4 8) :key #'1+)
  3)

(deftest position-list.12
  (position 5 '(1 2 3 4 5 6 4 8) :key '1+)
  3)

(deftest position-list.13
  (position 5 '(1 2 3 4 5 6 4 8) :key #'1+ :from-end t)
  6)

(deftest position-list.14
85
  (position 'a '(a a b a c e d a f a) :test (complement #'eql))
86 87 88
  2)

(deftest position-list.15
89
  (position 'a '(a a b a c e d a f a) :test (complement #'eql)
sds's avatar
sds committed
90
            :from-end t)
91 92 93
  8)

(deftest position-list.16
94
  (position 'a '(a a b a c e d a f a) :test-not #'eql)
95 96 97
  2)

(deftest position-list.17
98
  (position 'a '(a a b a c e d a f a) :test-not 'eql
sds's avatar
sds committed
99
            :from-end t)
100 101 102
  8)

(deftest position-list.18
103
  (position 'a '(a a b a c e d a f a) :test-not 'eql)
104 105 106
  2)

(deftest position-list.19
107
  (position 'a '(a a b a c e d a f a) :test-not #'eql
sds's avatar
sds committed
108
            :from-end t)
109 110 111
  8)

(deftest position-list.20
112
  (position 'a '(a a b a c e d a f a) :test-not #'eql)
113 114 115
  2)

(deftest position-list.21
116
  (position 'a '(a a b a c e d a f a) :test #'eql
sds's avatar
sds committed
117
            :start 2)
118 119 120
  3)

(deftest position-list.22
121
  (position 'a '(a a b a c e d a f a) :test #'eql
sds's avatar
sds committed
122
            :start 2 :end nil)
123 124 125
  3)

(deftest position-list.23
126
  (position 'a '(a a b a c e d a f a) :test-not #'eql
sds's avatar
sds committed
127
            :start 0 :end 5)
128 129 130
  2)

(deftest position-list.24
131
  (position 'a '(a a b a c e d a f a) :test-not #'eql
sds's avatar
sds committed
132
            :start 0 :end 5 :from-end t)
133 134 135 136 137 138 139 140 141 142 143 144
  4)

(deftest position-list.25
  (position '(a b) '(a (b a) (a b c) (a b) (d e) f) :test #'equal)
  3)

(deftest position-list.26
  (position 'a '((c) (b a) (a b c) (a b) (d e) f) :key #'car)
  2)

(deftest position-list.27
  (position 'a '((c) (b a) (a b c) (z) (a b) (d e) f) :key #'car
sds's avatar
sds committed
145
            :start 3)
146 147 148 149
  4)

(deftest position-list.28
  (position 'a '((c) (b a) (a b c) (z) (a b) (d e) (f)) :key #'car
sds's avatar
sds committed
150
            :start 2 :from-end t)
151 152
  4)

153 154 155 156 157 158 159 160
(deftest position-list.29
  (position 10 '(1 4 8 10 15 20) :test #'<)
  4)

(deftest position-list.30
  (position 10 '(1 4 8 10 15 20) :test-not #'>=)
  4)

161 162 163 164 165 166 167 168 169 170 171 172
;;; Tests on vectors

(deftest position-vector.1
  (position 'c #(a b c d e c a))
  2)

(deftest position-vector.2
  (position 'c #(a b c d e c a) :from-end t)
  5)

(deftest position-vector.3
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
173
        (position 'c #(a b c d e c a) :start i))
174 175 176 177
  (2 2 2 5 5 5 nil nil))

(deftest position-vector.4
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
178
        (position 'c #(a b c d e c a) :start i :end nil))
179 180 181 182
  (2 2 2 5 5 5 nil nil))

(deftest position-vector.5
  (loop for i from 7 downto 0 collect
sds's avatar
sds committed
183
        (position 'c #(a b c d e c a) :end i))
184 185 186 187
  (2 2 2 2 2 nil nil nil))

(deftest position-vector.6
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
188
        (position 'c #(a b c d e c a) :start i :from-end t))
189 190 191 192
  (5 5 5 5 5 5 nil nil))

(deftest position-vector.7
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
193
        (position 'c #(a b c d e c a) :start i :end nil :from-end t))
194 195 196 197
  (5 5 5 5 5 5 nil nil))

(deftest position-vector.8
  (loop for i from 7 downto 0 collect
sds's avatar
sds committed
198
        (position 'c #(a b c d e c a) :end i :from-end t))
199 200 201 202
  (5 5 2 2 2 nil nil nil))

(deftest position-vector.9
  (loop for i from 0 to 6 collect
sds's avatar
sds committed
203 204 205
        (loop for j from (1+ i) to 7
              collect
              (position 'c #(a b c d e c a) :start i :end j)))
206 207 208 209 210 211 212 213 214 215
  ((nil nil 2 2 2 2 2)
   (nil 2 2 2 2 2)
   (2 2 2 2 2)
   (nil nil 5 5)
   (nil 5 5)
   (5 5)
   (nil)))

(deftest position-vector.10
  (loop for i from 0 to 6 collect
sds's avatar
sds committed
216 217 218
        (loop for j from (1+ i) to 7
              collect
              (position 'c #(a b c d e c a) :start i :end j :from-end t)))
219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
  ((nil nil 2 2 2 5 5)
   (nil 2 2 2 5 5)
   (2 2 2 5 5)
   (nil nil 5 5)
   (nil 5 5)
   (5 5)
   (nil)))

(deftest position-vector.11
  (position 5 #(1 2 3 4 5 6 4 8) :key #'1+)
  3)

(deftest position-vector.12
  (position 5 #(1 2 3 4 5 6 4 8) :key '1+)
  3)

(deftest position-vector.13
  (position 5 #(1 2 3 4 5 6 4 8) :key #'1+ :from-end t)
  6)

(deftest position-vector.14
240
  (position 'a #(a a b a c e d a f a) :test (complement #'eql))
241 242 243
  2)

(deftest position-vector.15
244
  (position 'a #(a a b a c e d a f a) :test (complement #'eql)
sds's avatar
sds committed
245
            :from-end t)
246 247 248
  8)

(deftest position-vector.16
249
  (position 'a #(a a b a c e d a f a) :test-not #'eql)
250 251 252
  2)

(deftest position-vector.17
253
  (position 'a #(a a b a c e d a f a) :test-not 'eql
sds's avatar
sds committed
254
            :from-end t)
255 256 257
  8)

(deftest position-vector.18
258
  (position 'a #(a a b a c e d a f a) :test-not 'eql)
259 260 261
  2)

(deftest position-vector.19
262
  (position 'a #(a a b a c e d a f a) :test-not #'eql
sds's avatar
sds committed
263
            :from-end t)
264 265 266
  8)

(deftest position-vector.20
267
  (position 'a #(a a b a c e d a f a) :test-not #'eql)
268 269 270
  2)

(deftest position-vector.21
271
  (position 'a #(a a b a c e d a f a) :test #'eql
sds's avatar
sds committed
272
            :start 2)
273 274 275
  3)

(deftest position-vector.22
276
  (position 'a #(a a b a c e d a f a) :test #'eql
sds's avatar
sds committed
277
            :start 2 :end nil)
278 279 280
  3)

(deftest position-vector.23
281
  (position 'a #(a a b a c e d a f a) :test-not #'eql
sds's avatar
sds committed
282
            :start 0 :end 5)
283 284 285
  2)

(deftest position-vector.24
286
  (position 'a #(a a b a c e d a f a) :test-not #'eql
sds's avatar
sds committed
287
            :start 0 :end 5 :from-end t)
288 289 290 291 292 293 294 295 296 297 298 299
  4)

(deftest position-vector.25
  (position '(a b) #(a (b a) (a b c) (a b) (d e) f) :test #'equal)
  3)

(deftest position-vector.26
  (position 'a #((c) (b a) (a b c) (a b) (d e) f) :key #'car)
  2)

(deftest position-vector.27
  (position 'a #((c) (b a) (a b c) (z) (a b) (d e) f) :key #'car
sds's avatar
sds committed
300
            :start 3)
301 302 303 304
  4)

(deftest position-vector.28
  (position 'a #((c) (b a) (a b c) (z) (a b) (d e) (f)) :key #'car
sds's avatar
sds committed
305
            :start 2 :from-end t)
306 307
  4)

308 309
(deftest position-vector.29
  (position 'a (make-array '(10) :initial-contents '(b b b b b a a a a a)
sds's avatar
sds committed
310
                           :fill-pointer 5))
311 312 313 314
  nil)

(deftest position-vector.30
  (position 'a (make-array '(10) :initial-contents '(b b b b a a a a a a)
sds's avatar
sds committed
315
                           :fill-pointer 5))
316 317 318 319
  4)

(deftest position-vector.31
  (position 'a (make-array '(10) :initial-contents '(b a b b a a a a a a)
sds's avatar
sds committed
320 321
                           :fill-pointer 5)
            :from-end t)
322 323
  4)

324 325 326 327 328 329 330 331
(deftest position-vector.32
  (position 10 #(1 4 8 10 15 20) :test #'<)
  4)

(deftest position-vector.33
  (position 10 #(1 4 8 10 15 20) :test-not #'>=)
  4)

332 333
(deftest position-vector.34
  (let* ((v1 #(x x x a b c d a b c d y y y y y))
sds's avatar
sds committed
334 335
         (v2 (make-array '(8) :displaced-to v1
                         :displaced-index-offset 3)))
336
    (values (position 'c v2)
sds's avatar
sds committed
337 338
            (position 'c v2 :from-end t)))
  2 6)
339

340 341 342 343 344 345 346 347 348 349 350 351
;;; tests on bit vectors

(deftest position-bit-vector.1
  (position 1 #*001001010100)
  2)

(deftest position-bit-vector.2
  (position 1 #*001001010100 :from-end t)
  9)

(deftest position-bit-vector.3
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
352
        (position 1 #*0010010 :start i))
353 354 355 356
  (2 2 2 5 5 5 nil nil))

(deftest position-bit-vector.4
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
357
        (position 1 #*0010010 :start i :end nil))
358 359 360 361
  (2 2 2 5 5 5 nil nil))

(deftest position-bit-vector.5
  (loop for i from 7 downto 0 collect
sds's avatar
sds committed
362
        (position 1 #*0010010 :end i))
363 364 365 366
  (2 2 2 2 2 nil nil nil))

(deftest position-bit-vector.6
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
367
        (position 1 #*0010010 :start i :from-end t))
368 369 370 371
  (5 5 5 5 5 5 nil nil))

(deftest position-bit-vector.7
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
372
        (position 0 #*1101101 :start i :end nil :from-end t))
373 374 375 376
  (5 5 5 5 5 5 nil nil))

(deftest position-bit-vector.8
  (loop for i from 7 downto 0 collect
sds's avatar
sds committed
377
        (position 0 #*1101101 :end i :from-end t))
378 379 380 381
  (5 5 2 2 2 nil nil nil))

(deftest position-bit-vector.9
  (loop for i from 0 to 6 collect
sds's avatar
sds committed
382 383 384
        (loop for j from (1+ i) to 7
              collect
              (position 1 #*0010010 :start i :end j)))
385 386 387 388 389 390 391 392 393 394
  ((nil nil 2 2 2 2 2)
   (nil 2 2 2 2 2)
   (2 2 2 2 2)
   (nil nil 5 5)
   (nil 5 5)
   (5 5)
   (nil)))

(deftest position-bit-vector.10
  (loop for i from 0 to 6 collect
sds's avatar
sds committed
395 396 397
        (loop for j from (1+ i) to 7
              collect
              (position 1 #*0010010 :start i :end j :from-end t)))
398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418
  ((nil nil 2 2 2 5 5)
   (nil 2 2 2 5 5)
   (2 2 2 5 5)
   (nil nil 5 5)
   (nil 5 5)
   (5 5)
   (nil)))

(deftest position-bit-vector.11
  (position 2 #*00010001010 :key #'1+)
  3)

(deftest position-bit-vector.12
  (position 2 #*00010001010 :key '1+)
  3)

(deftest position-bit-vector.13
  (position 2 #*0010001000 :key #'1+ :from-end t)
  6)

(deftest position-bit-vector.14
419
  (position 0 #*0010111010 :test (complement #'eql))
420 421 422
  2)

(deftest position-bit-vector.15
423
  (position 0 #*0010111010 :test (complement #'eql)
sds's avatar
sds committed
424
            :from-end t)
425 426 427
  8)

(deftest position-bit-vector.16
428
  (position 0 #*0010111010 :test-not #'eql)
429 430 431
  2)

(deftest position-bit-vector.17
432
  (position 0 #*001011101 :test-not 'eql
sds's avatar
sds committed
433
            :from-end t)
434 435 436
  8)

(deftest position-bit-vector.18
437
  (position 0 #*00101110 :test-not 'eql)
438 439 440
  2)

(deftest position-bit-vector.19
441
  (position 0 #*00101110 :test-not #'eql
sds's avatar
sds committed
442
            :from-end t)
443 444 445
  6)

(deftest position-bit-vector.20
446
  (position 0 #*00101110 :test-not #'eql)
447 448 449
  2)

(deftest position-bit-vector.21
450
  (position 0 #*00101110 :test #'eql
sds's avatar
sds committed
451
            :start 2)
452 453 454
  3)

(deftest position-bit-vector.22
455
  (position 0 #*00101110 :test #'eql
sds's avatar
sds committed
456
            :start 2 :end nil)
457 458 459
  3)

(deftest position-bit-vector.23
460
  (position 0 #*00101110 :test-not #'eql
sds's avatar
sds committed
461
            :start 0 :end 5)
462 463 464
  2)

(deftest position-bit-vector.24
465
  (position 0 #*00101110 :test-not #'eql
sds's avatar
sds committed
466
            :start 0 :end 5 :from-end t)
467 468 469 470
  4)

(deftest position-bit-vector.25
  (position 2 #*1100001010 :key #'1+
sds's avatar
sds committed
471
            :start 3)
472 473 474 475
  6)

(deftest position-bit-vector.27
  (position 2 #*1100001010 :key #'1+
sds's avatar
sds committed
476
            :start 2 :from-end t)
477 478
  8)

479 480
(deftest position-bit-vector.28
  (position 0 (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0)
sds's avatar
sds committed
481 482
                          :element-type 'bit
                          :fill-pointer 5))
483 484 485 486
  nil)

(deftest position-bit-vector.29
  (position 0 (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0)
sds's avatar
sds committed
487 488 489
                          :element-type 'bit
                          :fill-pointer 5)
            :from-end t)
490 491 492 493
  nil)

(deftest position-bit-vector.30
  (position 0 (make-array '(10) :initial-contents '(1 1 1 1 0 0 0 0 0 0)
sds's avatar
sds committed
494 495
                          :element-type 'bit
                          :fill-pointer 5))
496 497 498 499
  4)

(deftest position-bit-vector.31
  (position 0 (make-array '(10) :initial-contents '(0 1 0 1 0 0 0 0 0 0)
sds's avatar
sds committed
500 501 502
                          :element-type 'bit
                          :fill-pointer 5)
            :from-end t)
503 504 505 506
  4)

(deftest position-bit-vector.32
  (position 0 (make-array '(10) :initial-contents '(1 0 1 1 0 0 0 0 0 0)
sds's avatar
sds committed
507 508
                          :element-type 'bit
                          :fill-pointer 5))
509 510
  1)

511 512 513 514 515 516 517 518
(deftest position-bit-vector.33
  (position 0 #*1111000 :test #'>=)
  4)

(deftest position-bit-vector.34
  (position 0 #*1111000 :test-not #'<)
  4)

519 520 521 522 523 524 525 526 527 528 529 530
;;; strings

(deftest position-string.1
  (position #\c "abcdeca")
  2)

(deftest position-string.2
  (position #\c "abcdeca" :from-end t)
  5)

(deftest position-string.3
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
531
        (position #\c "abcdeca" :start i))
532 533 534 535
  (2 2 2 5 5 5 nil nil))

(deftest position-string.4
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
536
        (position #\c "abcdeca" :start i :end nil))
537 538 539 540
  (2 2 2 5 5 5 nil nil))

(deftest position-string.5
  (loop for i from 7 downto 0 collect
sds's avatar
sds committed
541
        (position #\c "abcdeca" :end i))
542 543 544 545
  (2 2 2 2 2 nil nil nil))

(deftest position-string.6
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
546
        (position #\c "abcdeca" :start i :from-end t))
547 548 549 550
  (5 5 5 5 5 5 nil nil))

(deftest position-string.7
  (loop for i from 0 to 7 collect
sds's avatar
sds committed
551
        (position #\c "abcdeca" :start i :end nil :from-end t))
552 553 554 555
  (5 5 5 5 5 5 nil nil))

(deftest position-string.8
  (loop for i from 7 downto 0 collect
sds's avatar
sds committed
556
        (position #\c "abcdeca" :end i :from-end t))
557 558 559 560
  (5 5 2 2 2 nil nil nil))

(deftest position-string.9
  (loop for i from 0 to 6 collect
sds's avatar
sds committed
561 562 563
        (loop for j from (1+ i) to 7
              collect
              (position #\c "abcdeca" :start i :end j)))
564 565 566 567 568 569 570 571 572 573
  ((nil nil 2 2 2 2 2)
   (nil 2 2 2 2 2)
   (2 2 2 2 2)
   (nil nil 5 5)
   (nil 5 5)
   (5 5)
   (nil)))

(deftest position-string.10
  (loop for i from 0 to 6 collect
sds's avatar
sds committed
574 575 576
        (loop for j from (1+ i) to 7
              collect
              (position #\c "abcdeca" :start i :end j :from-end t)))
577 578 579 580 581 582 583 584 585 586
  ((nil nil 2 2 2 5 5)
   (nil 2 2 2 5 5)
   (2 2 2 5 5)
   (nil nil 5 5)
   (nil 5 5)
   (5 5)
   (nil)))

(deftest position-string.11
  (position 5 "12345648" :key #'(lambda (c)
sds's avatar
sds committed
587
                                  (1+ (read-from-string (string c)))))
588 589 590 591
  3)

(deftest position-string.13
  (position 5 "12345648" :key #'(lambda (c)
sds's avatar
sds committed
592 593
                                  (1+ (read-from-string (string c))))
            :from-end t)
594 595 596
  6)

(deftest position-string.14
597
  (position #\a "aabacedafa" :test (complement #'eql))
598 599 600
  2)

(deftest position-string.15
601
  (position #\a "aabacedafa" :test (complement #'eql)
sds's avatar
sds committed
602
            :from-end t)
603 604 605
  8)

(deftest position-string.16
606
  (position #\a "aabacedafa" :test-not #'eql)
607 608 609
  2)

(deftest position-string.17
610
  (position #\a "aabacedafa" :test-not 'eql
sds's avatar
sds committed
611
            :from-end t)
612 613 614
  8)

(deftest position-string.18
615
  (position #\a "aabacedafa" :test-not 'eql)
616 617 618
  2)

(deftest position-string.19
619
  (position #\a "aabacedafa" :test-not #'eql
sds's avatar
sds committed
620
            :from-end t)
621 622 623
  8)

(deftest position-string.20
624
  (position #\a "aabacedafa" :test-not #'eql)
625 626 627
  2)

(deftest position-string.21
628
  (position #\a "aabacedafa" :test #'eql
sds's avatar
sds committed
629
            :start 2)
630 631 632
  3)

(deftest position-string.22
633
  (position #\a "aabacedafa" :test #'eql
sds's avatar
sds committed
634
            :start 2 :end nil)
635 636 637
  3)

(deftest position-string.23
638
  (position #\a "aabacedafa" :test-not #'eql
sds's avatar
sds committed
639
            :start 0 :end 5)
640 641 642
  2)

(deftest position-string.24
643
  (position #\a "aabacedafa" :test-not #'eql
sds's avatar
sds committed
644
            :start 0 :end 5 :from-end t)
645 646
  4)

647
(deftest position-string.25
648
  (position #\a (make-array '(10) :initial-contents "bbbbbaaaaa"
sds's avatar
sds committed
649 650
                            :element-type 'character
                            :fill-pointer 5))
651 652 653
  nil)

(deftest position-string.26
654
  (position #\a (make-array '(10) :initial-contents "bbbbbaaaaa"
sds's avatar
sds committed
655 656 657
                            :element-type 'character
                            :fill-pointer 5)
            :from-end t)
658 659 660
  nil)

(deftest position-string.27
661
  (position #\a (make-array '(10) :initial-contents "bbbbaaaaaa"
sds's avatar
sds committed
662 663
                            :element-type 'character
                            :fill-pointer 5))
664 665 666
  4)

(deftest position-string.28
667
  (position #\a (make-array '(10) :initial-contents "babbaaaaaa"
sds's avatar
sds committed
668 669 670
                            :element-type 'character
                            :fill-pointer 5)
            :from-end t)
671 672
  4)

673 674 675 676 677 678 679 680
(deftest position-string.29
  (position #\m "adfmpz" :test #'char<)
  4)

(deftest position-string.30
  (position #\m "adfmpz" :test-not #'char>=)
  4)

681 682
(deftest position-string.31
  (let* ((s1 (copy-seq "xxxabcdyyyyy"))
sds's avatar
sds committed
683 684 685
         (s2 (make-array '(4) :displaced-to s1
                         :displaced-index-offset 3
                         :element-type (array-element-type s1))))
686 687 688 689 690
    (position #\c s2))
  2)

(deftest position-string.32
  (let* ((s1 (copy-seq "xxxabcdabcdyyyyyyyy"))
sds's avatar
sds committed
691 692 693
         (s2 (make-array '(8) :displaced-to s1
                         :displaced-index-offset 3
                         :element-type (array-element-type s1))))
694
    (position #\c s2 :from-end t))
pfdietz's avatar
pfdietz committed
695
  6)
696 697 698 699 700

(deftest position-string.33
  (do-special-strings
   (s "abcdabcdabcd" nil)
   (let* ((c #\c)
sds's avatar
sds committed
701
          (pos (position c s)))
702 703 704 705 706 707 708
     (assert (eql pos 2) () "First position of ~A in ~A is ~A" c s pos)))
  nil)

(deftest position-string.34
  (do-special-strings
   (s "abcdabcdabcd" nil)
   (let* ((c #\c)
sds's avatar
sds committed
709
          (pos (position c s :from-end t)))
pfdietz's avatar
pfdietz committed
710
     (assert (eql pos 10) () "Last position of ~A in ~A is ~A" c s pos)))
711 712
  nil)

713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736
(defharmless position.test-and-test-not.1
  (position 'b '(a b c d) :test #'eql :test-not #'eql))

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

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

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

(defharmless position.test-and-test-not.5
  (position #\b "abcd" :test #'eql :test-not #'eql))

(defharmless position.test-and-test-not.6
  (position #\b "abcd" :test-not #'eql :test #'eql))

(defharmless position.test-and-test-not.7
  (position 1 #*001010010 :test #'eql :test-not #'eql))

(defharmless position.test-and-test-not.8
  (position 0 #*1110010110111 :test-not #'eql :test #'eql))

737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766
(deftest position.order.1
  (let ((i 0) a b c d e f g)
    (values
     (position
      (progn (setf a (incf i)) 0)
      (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4))
      :from-end (setf c (incf i))
      :start (progn (setf d (incf i)) 1)
      :end (progn (setf e (incf i)) 6)
      :key (progn (setf f (incf i)) #'1-)
      :test (progn (setf g (incf i)) #'=)
      )
     i a b c d e f g))
  4 7 1 2 3 4 5 6 7)

(deftest position.order.2
  (let ((i 0) a b c d e f g)
    (values
     (position
      (progn (setf a (incf i)) 0)
      (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4))
      :test-not (progn (setf c (incf i)) #'/=)
      :key (progn (setf d (incf i)) #'1-)
      :end (progn (setf e (incf i)) 6)
      :start (progn (setf f (incf i)) 1)
      :from-end (setf g (incf i))
      )
     i a b c d e f g))
  4 7 1 2 3 4 5 6 7)

767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794
;;; Keyword tests

(deftest position.allow-other-keys.1
  (position 0 '(1 2 0 3 2 1) :allow-other-keys t)
  2)

(deftest position.allow-other-keys.2
  (position 0 '(1 2 0 3 2 1) :allow-other-keys nil)
  2)

(deftest position.allow-other-keys.3
  (position 0 '(1 2 0 3 2 1) :allow-other-keys t :bad t)
  2)

(deftest position.allow-other-keys.4
  (position 0 '(1 2 0 3 2 1) :bad t :allow-other-keys t)
  2)

(deftest position.allow-other-keys.5
  (position 0 '(1 2 0 3 2 1) :bad t :allow-other-keys t :key #'1-)
  0)

(deftest position.keywords.6
  (position 0 '(1 2 0 3 2 1) :key #'1- :key #'identity)
  0)

(deftest position.allow-other-keys.7
  (position 0 '(1 2 0 3 2 1) :bad t :allow-other-keys t
sds's avatar
sds committed
795
               :allow-other-keys nil)
796 797 798 799
  2)

(deftest position.allow-other-keys.8
  (position 0 '(1 2 0 3 2 1) :allow-other-keys t :bad t
sds's avatar
sds committed
800
               :allow-other-keys nil)
801 802 803 804
  2)

(deftest position.allow-other-keys.9
  (position 0 '(1 2 0 3 2 1) :allow-other-keys t
sds's avatar
sds committed
805
               :allow-other-keys nil :bad t)
806 807
  2)

808 809
;;; Error tests

810
(deftest position.error.1
pfdietz's avatar
pfdietz committed
811 812
  (check-type-error #'(lambda (x) (position 'a x)) #'sequencep)
  nil)
813

814
(deftest position.error.4
815 816
  (signals-error (position 'e '(a b c . d)) type-error)
  t)
817

818
(deftest position.error.5
819 820
  (signals-error (position) program-error)
  t)
821

822
(deftest position.error.6
823 824
  (signals-error (position 'a) program-error)
  t)
825

826
(deftest position.error.7
827 828
  (signals-error (position 'a nil :key) program-error)
  t)
829

830
(deftest position.error.8
831 832
  (signals-error (position 'a nil 'bad t) program-error)
  t)
833 834

(deftest position.error.9
835 836
  (signals-error (position 'a nil 'bad t :allow-other-keys nil) program-error)
  t)
837 838

(deftest position.error.10
839 840
  (signals-error (position 'a nil 1 2) program-error)
  t)
841

842
(deftest position.error.11
843 844
  (signals-error (locally (position 'a 'b) t) type-error)
  t)
845 846

(deftest position.error.12
847 848
  (signals-error (position 'b '(a b c d) :test #'identity) program-error)
  t)
849 850

(deftest position.error.13
851 852
  (signals-error (position 'b '(a b c d) :test-not #'not) program-error)
  t)
853 854

(deftest position.error.14
855 856
  (signals-error (position 'b '(a b c d) :key #'cdr) type-error)
  t)
857 858

(deftest position.error.15
859 860
  (signals-error (position 'b '(a b c d) :key #'cons) program-error)
  t)