SETQ signals error if the first argument is not a symbol
[jscl.git] / tests / seq.lisp
1 ; Functions used as :KEY argument in tests
2 (defvar halve  (lambda (x) (/ x 2)))
3 (defvar double (lambda (x) (* x 2)))
4
5 ; FIND
6 (test (find 1 #(2 1 3)))
7 (test (find 1 '(2 1 3)))
8 (test (not (find 1 #(2 2 2))))
9 (test (not (find 1 '(2 2 2))))
10 (test (not (find 1 #(1 1 1) :test-not #'=)))
11 (test (not (find 1 '(1 1 1) :test-not #'=)))
12 (test (not (find 1 #(1 2 3) :key double)))
13 (test (not (find 1 '(1 2 3) :key double)))
14
15 ; REMOVE
16 (test (not (find 1 (remove 1 #(1 2 3 1)))))
17 (test (not (find 1 (remove 1 '(1 2 3 1)))))
18 (test (not (find 2 (remove 1 #(1 2 3 1) :key halve))))
19 (test (not (find 2 (remove 1 '(1 2 3 1) :key halve))))
20 ;; TODO: Rewrite this test when EQUALP exists and works on vectors
21 (test (equal (length (remove '(1 2) #((1 2) (1 2)) :test #'equal)) 0))
22 (test (null          (remove '(1 2) '((1 2) (1 2)) :test #'equal)))
23 (test (find 2 (remove 2 #(1 2 3) :test-not #'=)))
24 (test (find 2 (remove 2 '(1 2 3) :test-not #'=)))
25
26 ; POSITION
27 (test (= (position 1 #(1 2 3))  0))
28 (test (= (position 1 '(1 2 3))  0))
29 (test (= (position 1 #(1 2 3 1)) 0))
30 (test (= (position 1 '(1 2 3 1)) 0))
31 (test (not (position 1 #(2 3 4))))
32 (test (not (position 1 '(2 3 4))))
33 (test (= (position 1 '(1 2 3) :key halve) 1))
34 (test (= (position 1 #(1 2 3) :key halve) 1))
35 (test (= (position '(1 2) '((1 2) (3 4)) :test #'equal) 0))
36 (test (= (position '(1 2) #((1 2) (3 4)) :test #'equal) 0))
37 (test (= (position 1 #(1 1 3) :test-not #'=) 2))
38 (test (= (position 1 '(1 1 3) :test-not #'=) 2))
39
40 ;; POSITION-IF, POSITION-IF-NOT
41 (test (= 2 (position-if #'oddp '((1) (2) (3) (4)) :start 1 :key #'car)))
42 (test (= 4 (position-if-not #'integerp '(1 2 3 4 X))))  ;; (hyperspec example used "5.0", but we don't have a full numeric tower yet!)
43
44 ; REMOVE-IF
45 (test (equal (remove-if     #'zerop '(1 0 2 0 3)) '(1 2 3)))
46 (test (equal (remove-if-not #'zerop '(1 0 2 0 3)) '(0 0)))
47 ;; TODO: Rewrite these tests when EQUALP exists and works on vectors
48 (let ((v1 (remove-if #'zerop #(1 0 2 0 3))))
49   (test (and (= (aref v1 0) 1) (= (aref v1 1) 2) (= (aref v1 2) 3)))) 
50 (test (every #'zerop (remove-if-not #'zerop #(1 0 2 0 3))))
51
52 ; SUBSEQ
53 (let ((nums '(1 2 3 4 5)))
54   (test (equal (subseq nums 3) '(4 5)))
55   (test (equal (subseq nums 2 4) '(3 4)))
56   ; Test that nums hasn't been altered: SUBSEQ should construct fresh lists
57   (test (equal nums '(1 2 3 4 5))))
58
59 ;;; REDUCE
60 (test (equal (reduce (lambda (x y) `(+ ,x ,y))
61                      '(1 2 3 4))
62              '(+ (+ (+ 1 2) 3) 4)))
63
64 (test (equal (reduce (lambda (x y) `(+ ,x ,y))
65                      '(1 2 3 4)
66                      :from-end t)
67              '(+ 1 (+ 2 (+ 3 4)))))
68
69 (test (equal (reduce #'+ nil)  0))
70 (test (equal (reduce #'+ '(1)) 1))
71 (test (equal (reduce #'+ nil :initial-value 1) 1))
72
73 (test (equal (reduce #'+ '()
74                      :key #'1+
75                      :initial-value 100)
76              100))
77
78 (test (equal (reduce #'+ '(100) :key #'1+)
79              101))
80
81 ; MISMATCH
82 (test (= (mismatch '(1 2 3) '(1 2 3 4 5 6)) 3))
83 (test (= (mismatch '(1 2 3) #(1 2 3 4 5 6)) 3))
84 (test (= (mismatch #(1 2 3) '(1 2 3 4 5 6)) 3))
85 (test (= (mismatch #(1 2 3) #(1 2 3 4 5 6)) 3))
86
87 ; SEARCH
88 (test (= (search '(1 2 3) '(4 5 6 1 2 3)) 3))
89 (test (= (search '(1 2 3) #(4 5 6 1 2 3)) 3))
90 (test (= (search #(1 2 3) '(4 5 6 1 2 3)) 3))
91 (test (= (search #(1 2 3) #(4 5 6 1 2 3)) 3))
92 (test (not (search '(foo) '(1 2 3))))
93 (test (= (search '(1) '(4 5 6 1 2 3)) 3))
94 (test (= (search #(1) #(4 5 6 1 2 3)) 3))