Add *version* variable
[jscl.git] / tests / list.lisp
1 ;; Tests for list functions
2
3 ;; CONS
4 (test (equal (cons 1 2) '(1 . 2)))
5 (test (equal (cons 1 nil) '(1)))
6 (test (equal (cons nil 2) '(NIL . 2)))
7 (test (equal (cons nil nil) '(NIL)))
8 (test (equal (cons 1 (cons 2 (cons 3 (cons 4 nil)))) '(1 2 3 4)))
9 (test (equal (cons 'a 'b) '(A . B)))
10 (test (equal (cons 'a (cons 'b (cons 'c '()))) '(A B C)))
11 (test (equal (cons 'a '(b c d)) '(A B C D)))
12
13 ;; CONSP
14 (test (not (consp 'nil)))
15 (test (not (consp nil)))
16 (test (not (consp ())))
17 (test (not (consp '())))
18 (test (consp (cons 1 2)))
19
20 ;; ATOM
21 (test (atom 'sss))
22 (test (not (atom (cons 1 2))))
23 (test (atom nil))
24 (test (atom '()))
25 (test (atom 3))
26
27 ;; RPLACA
28 (let ((some-list (list* 'one 'two 'three 'four)))
29   (test (equal (rplaca some-list 'uno) '(UNO TWO THREE . FOUR)))
30   (test (equal some-list '(UNO TWO THREE . FOUR))))
31
32 ;; RPLACD
33 (let ((some-list (list* 'one 'two 'three 'four)))
34   (test (equal (rplacd (last some-list) (list 'IV)) '(THREE IV)))
35   (test (equal some-list '(ONE TWO THREE IV))))
36
37 ;; CAR, CDR and variants
38 (test (equal (car nil) nil))
39 (test (equal (cdr '(1 . 2)) 2))
40 (test (equal (cdr '(1 2)) '(2)))
41 (test (equal (cadr '(1 2)) 2))
42 (test (equal (car '(a b c)) 'a))
43 (test (equal (cdr '(a b c)) '(b c)))
44 (test (equal (caar '((1 2) 3)) 1))
45 (test (equal (cadr '(1 2 3)) 2))
46 (test (equal (cdar '((1 2) 3)) '(2)))
47 (test (equal (cddr '(1 2 3)) '(3)))
48 (test (equal (caaar '(((1)))) 1))
49 (test (equal (caadr '(1 (2))) 2))
50 (test (equal (cadar '((1 2))) 2))
51 (test (equal (caddr '(1 2 3)) 3))
52 (test (equal (cdaar '(((1 2)))) '(2)))
53 (test (equal (cdadr '(1 (2 3))) '(3)))
54 (test (equal (cddar '((1 2 3))) '(3)))
55 (test (equal (cdddr '(1 2 3 4)) '(4)))
56 (test (equal (caaaar '((((1))))) 1))
57 (test (equal (caaadr '(1 ((2)))) 2))
58 (test (equal (caadar '((1 (2)))) 2))
59 (test (equal (caaddr '(1 2 (3))) 3))
60 (test (equal (cadaar '(((1 2)))) 2))
61 (test (equal (cadadr '(1 (2 3))) 3))
62 (test (equal (caddar '((1 2 3))) 3))
63 (test (equal (cadddr '(1 2 3 4)) 4))
64 (test (equal (cdaaar '((((1 2))))) '(2)))
65 (test (equal (cdaadr '(1 ((2 3)))) '(3)))
66 (test (equal (cdadar '((1 (2 3)))) '(3)))
67 (test (equal (cdaddr '(1 2 (3 4))) '(4)))
68 (test (equal (cddaar '(((1 2 3)))) '(3)))
69 (test (equal (cddadr '(1 (2 3 4))) '(4)))
70 (test (equal (cdddar '((1 2 3 4))) '(4)))
71 (test (equal (cddddr '(1 2 3 4 5)) '(5)))
72
73 ;; SUBLIS
74 (test (equal (sublis '((x . 100) (z . zprime))
75                      '(plus x (minus g z x p) 4 . x))
76              '(PLUS 100 (MINUS G ZPRIME 100 P) 4 . 100)))
77 (test (equal (sublis '(((+ x y) . (- x y)) ((- x y) . (+ x y)))
78                      '(* (/ (+ x y) (+ x p)) (- x y))
79                      :test #'equal)
80              '(* (/ (- X Y) (+ X P)) (+ X Y))))
81 (let ((tree1 '(1 (1 2) ((1 2 3)) (((1 2 3 4))))))
82   (test (equal (sublis '((3 . "three")) tree1)
83                '(1 (1 2) ((1 2 "three")) (((1 2 "three" 4))))))
84   (test (equal (sublis '((t . "string"))
85                        (sublis '((1 . "") (4 . 44)) tree1)
86                        :key #'stringp)
87                '("string" ("string" 2) (("string" 2 3)) ((("string" 2 3 44))))))
88   (test (equal tree1 '(1 (1 2) ((1 2 3)) (((1 2 3 4)))))))
89 (let ((tree2 '("one" ("one" "two") (("one" "Two" "three")))))
90   (test (equal (sublis '(("two" . 2)) tree2)
91                '("one" ("one" "two") (("one" "Two" "three")))))
92   (test (equal tree2 '("one" ("one" "two") (("one" "Two" "three")))))
93   (test (equal (sublis '(("two" . 2)) tree2 :test 'equal)
94                '("one" ("one" 2) (("one" "Two" "three"))))))
95
96 ;; SUBST
97 (let ((tree1 '(1 (1 2) (1 2 3) (1 2 3 4))))
98   (test (equal (subst "two" 2 tree1) '(1 (1 "two") (1 "two" 3) (1 "two" 3 4))))
99   (test (equal (subst "five" 5 tree1) '(1 (1 2) (1 2 3) (1 2 3 4))))
100   (test (eq tree1 (subst "five" 5 tree1))) ; Implementation dependent
101   (test (equal tree1 '(1 (1 2) (1 2 3) (1 2 3 4)))))
102 (test (equal (subst 'tempest 'hurricane
103                     '(shakespeare wrote (the hurricane)))
104              '(SHAKESPEARE WROTE (THE TEMPEST))))
105 (test (equal (subst 'foo 'nil '(shakespeare wrote (twelfth night)))
106              '(SHAKESPEARE WROTE (TWELFTH NIGHT . FOO) . FOO)))
107 (test (equal (subst '(a . cons) '(old . pair)
108                     '((old . spice) ((old . shoes) old . pair) (old . pair))
109                     :test #'equal)
110              '((OLD . SPICE) ((OLD . SHOES) A . CONS) (A . CONS))))
111
112 ; COPY-TREE
113 (test (let* ((foo (list '(1 2) '(3 4)))
114              (bar (copy-tree foo)))
115         ;; (SETF (CAR (CAR FOO)) 0) doesn't work in the test for some reason,
116         ;; despite working fine in the REPL
117         (rplaca (car foo) 0)
118         (not (= (car (car foo))
119                 (car (car bar))))))
120
121 ; TREE-EQUAL
122 (test (tree-equal '(1 2 3) '(1 2 3)))
123 (test (not (tree-equal '(1 2 3) '(3 2 1))))
124 (test (tree-equal '(1 (2 (3 4) 5) 6) '(1 (2 (3 4) 5) 6)))
125 (test (tree-equal (cons 1 2) (cons 2 3) :test (lambda (a b) (not (= a b)))))
126 (test (tree-equal '(1 . 2) '(2 . 1) :test-not #'eql))
127 (test (not (tree-equal '(1 . 2) '(1 . 2) :test-not #'eql)))
128
129 ; FIRST to TENTH
130 (let ((nums '(1 2 3 4 5 6 7 8 9 10)))
131   (test (= (first   nums) 1))
132   (test (= (second  nums) 2))
133   (test (= (third   nums) 3))
134   (test (= (fourth  nums) 4))
135   (test (= (fifth   nums) 5))
136   (test (= (sixth   nums) 6))
137   (test (= (seventh nums) 7))
138   (test (= (eighth  nums) 8))
139   (test (= (ninth   nums) 9))
140   (test (= (tenth   nums) 10)))
141
142 ; TAILP
143 (let* ((a (list 1 2 3))
144        (b (cdr a)))
145   (test (tailp b a))
146   (test (tailp a a)))
147 (test (tailp 'a (cons 'b 'a)))
148
149 ; ACONS
150 (test (equal '((1 . 2) (3 . 4))
151              (acons 1 2 '((3 . 4)))))
152 (test (equal '((1 . 2)) (acons 1 2 ())))
153
154 ; PAIRLIS
155 (test (equal '((1 . 3) (0 . 2))
156              (pairlis '(0 1) '(2 3))))
157 (test (equal '((1 . 2) (a . b))
158              (pairlis '(1) '(2) '((a . b)))))
159
160 ; COPY-ALIST
161 (let* ((alist '((1 . 2) (3 . 4)))
162        (copy (copy-alist alist)))
163   (test (not (eql alist copy)))
164   (test (not (eql (car alist) (car copy))))
165   (test (equal alist copy)))
166
167 ; ASSOC and RASSOC
168 (let ((alist '((1 . 2) (3 . 4))))
169   (test (equal (assoc  1 alist) '(1 . 2)))
170   (test (equal (rassoc 2 alist) '(1 . 2)))
171   (test (not   (assoc  2 alist)))
172   (test (not   (rassoc 1 alist)))
173   (test (equal (assoc  3 alist :test-not #'=) '(1 . 2)))
174   (test (equal (rassoc 4 alist :test-not #'=) '(1 . 2)))
175   (test (equal (assoc  1 alist :key (lambda (x) (/ x 3))) '(3 . 4)))
176   (test (equal (rassoc 2 alist :key (lambda (x) (/ x 2))) '(3 . 4)))) 
177
178 ; MEMBER
179 (test (equal (member 2 '(1 2 3)) '(2 3)))
180 (test (not   (member 4 '(1 2 3))))
181 (test (equal (member 4 '((1 . 2) (3 . 4)) :key #'cdr) '((3 . 4))))
182 (test (member '(2) '((1) (2) (3)) :test #'equal))
183 (test (member 1 '(1 2 3) :test-not #'eql))
184
185 ; ADJOIN
186 (test (equal (adjoin 1 '(2 3))   '(1 2 3)))
187 (test (equal (adjoin 1 '(1 2 3)) '(1 2 3)))
188 (test (equal (adjoin '(1) '((1) (2)) :test #'equal) '((1) (2))))
189
190 ; INTERSECTION
191 (test (equal (intersection '(1 2) '(2 3)) '(2)))
192 (test (not (intersection '(1 2 3) '(4 5 6))))
193 (test (equal (intersection '((1) (2)) '((2) (3)) :test #'equal) '((2))))
194 (test (equal '((1 . 2))
195              (intersection '((1 . 2) (2 . 3)) '((9 . 2) (9 . 4))
196                            :test #'equal :key #'cdr)))
197
198 ; POP
199 (test (let* ((foo '(1 2 3))
200              (bar (pop foo)))
201         (and (= bar 1)
202              (= (car foo) 2))))
203
204 ;; MAPCAR
205 (test (equal (mapcar #'+ '(1 2) '(3) '(4 5 6)) '(8)))
206
207 ;; MAPLIST
208 (test (equal '((1 2 3 4 1 2 1 2 3) (2 3 4 2 2 3))
209              (maplist #'append '(1 2 3 4) '(1 2) '(1 2 3))))
210 (test (equal '((FOO A B C D) (FOO B C D) (FOO C D) (FOO D))
211              (maplist #'(lambda (x) (cons 'foo x)) '(a b c d))))
212 (test (equal '(0 0 1 0 1 1 1)
213              (maplist #'(lambda (x) (if (member (car x) (cdr x)) 0 1)) '(a b a c d b c))))
214
215 ;; MAPC
216 (test (equal (mapc #'+ '(1 2) '(3) '(4 5 6)) '(1 2)))
217 (test (let (foo)
218         (mapc (lambda (x y z) (push (+ x y z) foo)) '(1 2) '(3) '(4 5 6))
219         (equal foo '(8))))
220
221 ;; GETF
222 (test (eq (getf '(a b c d) 'a) 'b))
223 (test (null (getf '(a b c d) 'e)))
224 (test (equal (let ((x (list 'a 1))) (setf (getf x 'a) 3) x) '(a 3)))
225 (test (equal (let ((x (list 'a 1))) (incf (getf x 'a)) x) '(a 2)))
226
227 ;; GET-PROPERTIES
228 (test (equal (multiple-value-list (get-properties '(a b c d) '(b d e))) '(NIL NIL NIL)))
229 (test (equal (multiple-value-list (get-properties '(a b c d) '(b a c))) '(a b (a b c d))))
230 (test (equal (multiple-value-list (get-properties '(a b c d) '(b c a))) '(a b (a b c d))))
231
232 ;; BUTLAST
233 (test (equal (butlast '()) ()))
234 (test (equal (butlast '(1)) ()))
235 (test (equal (butlast '(1 2)) '(1)))
236 (test (equal (butlast '(1 2 3 4 5)) '(1 2 3 4)))
237 (test (equal '(1 2 3 4) (butlast '(1 2 3 4 5))))
238 (test (equal (let ((thing '(1 2 3 4 5))) (butlast thing)) '(1 2 3 4)))
239 (test (equal (let ((thing '(1 2 3 4 5))) (butlast thing) thing) '(1 2 3 4 5)))
240
241 (test (equal (let ((thing '(1 2 3 4 5))) (butlast thing 0)) '(1 2 3 4 5)))
242 (test (equal (let ((thing '(1 2 3 4 5))) (butlast thing 1)) '(1 2 3 4)))
243 (test (equal (let ((thing '(1 2 3 4 5))) (butlast thing 2)) '(1 2 3)))
244 (test (equal (let ((thing '())) (butlast thing 2)) '()))
245 (test (equal (let ((thing '(1 2))) (butlast thing 2)) '()))
246 (test (equal (let ((thing '())) (butlast thing 0)) '()))
247
248 ;; MAKE-LIST
249 (test (equal (make-list 5) '(nil nil nil nil nil)))
250 (test (equal (make-list 3 :initial-element 'rah) '(rah rah rah)))