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)))