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 (assoc 1 alist :key (lambda (x) (/ x 3))) '(3 . 4))))
 175
 176 ; MEMBER
 177 (test (equal (member 2 '(1 2 3)) '(2 3)))
 178 (test (not   (member 4 '(1 2 3))))
 179 (test (equal (member 4 '((1 . 2) (3 . 4)) :key #'cdr) '((3 . 4))))
 180 (test (member '(2) '((1) (2) (3)) :test #'equal))
 181 (test (member 1 '(1 2 3) :test-not #'eql))
 182
 183 ; ADJOIN
 184 (test (equal (adjoin 1 '(2 3))   '(1 2 3)))
 185 (test (equal (adjoin 1 '(1 2 3)) '(1 2 3)))
 186 (test (equal (adjoin '(1) '((1) (2)) :test #'equal) '((1) (2))))
 187
 188 ; INTERSECTION
 189 (test (equal (intersection '(1 2) '(2 3)) '(2)))
 190 (test (not (intersection '(1 2 3) '(4 5 6))))
 191 (test (equal (intersection '((1) (2)) '((2) (3)) :test #'equal) '((2))))
 192
 193 ; POP
 194 (test (let* ((foo '(1 2 3))
 195              (bar (pop foo)))
 196         (and (= bar 1)
 197              (= (car foo) 2))))
 198
 199 ;; MAPCAR
 200 (test (equal (mapcar #'+ '(1 2) '(3) '(4 5 6)) '(8)))
 201
 202 ;; MAPC
 203 (test (equal (mapc #'+ '(1 2) '(3) '(4 5 6)) '(1 2)))
 204 (test (let (foo)
 205         (mapc (lambda (x y z) (push (+ x y z) foo)) '(1 2) '(3) '(4 5 6))
 206         (equal foo '(8))))