1 ;; Tests for list functions
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)))
14 (test (not (consp 'nil)))
15 (test (not (consp nil)))
16 (test (not (consp ())))
17 (test (not (consp '())))
18 (test (consp (cons 1 2)))
22 (test (not (atom (cons 1 2))))
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))))
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))))
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)))
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))
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)
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"))))))
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))
110 '((OLD . SPICE) ((OLD . SHOES) A . CONS) (A . CONS))))
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
118 (not (= (car (car foo))
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)))
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)))
143 (let* ((a (list 1 2 3))
147 (test (tailp 'a (cons 'b 'a)))
150 (test (equal '((1 . 2) (3 . 4))
151 (acons 1 2 '((3 . 4)))))
152 (test (equal '((1 . 2)) (acons 1 2 ())))
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)))))
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)))
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))))
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))
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))))
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))))
196 (test (let* ((foo '(1 2 3))
202 (test (equal (mapcar #'+ '(1 2) '(3) '(4 5 6)) '(8)))
205 (test (equal (mapc #'+ '(1 2) '(3) '(4 5 6)) '(1 2)))
207 (mapc (lambda (x y z) (push (+ x y z) foo)) '(1 2) '(3) '(4 5 6))