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 (tree-equal '(1 (2 (3 4) 5) 6) '(1 (2 (3 4) 5) 6)))
 124 (test (tree-equal (cons 1 2) (cons 2 3)
 125                   :test (lambda (a b) (not (= a b)))))
 126
 127 ; FIRST to TENTH
 128 (let ((nums '(1 2 3 4 5 6 7 8 9 10)))
 129   (test (= (first   nums) 1))
 130   (test (= (second  nums) 2))
 131   (test (= (third   nums) 3))
 132   (test (= (fourth  nums) 4))
 133   (test (= (fifth   nums) 5))
 134   (test (= (sixth   nums) 6))
 135   (test (= (seventh nums) 7))
 136   (test (= (eighth  nums) 8))
 137   (test (= (ninth   nums) 9))
 138   (test (= (tenth   nums) 10)))
 139
 140 ; TAILP
 141 (let* ((a (list 1 2 3))
 142        (b (cdr a)))
 143   (test (tailp b a))
 144   (test (tailp a a)))
 145 (test (tailp 'a (cons 'b 'a)))
 146
 147 ; ACONS
 148 (test (equal '((1 . 2) (3 . 4))
 149              (acons 1 2 '((3 . 4)))))
 150 (test (equal '((1 . 2)) (acons 1 2 ())))
 151
 152 ; PAIRLIS
 153 (test (equal '((1 . 3) (0 . 2))
 154              (pairlis '(0 1) '(2 3))))
 155 (test (equal '((1 . 2) (a . b))
 156              (pairlis '(1) '(2) '((a . b)))))
 157
 158 ; COPY-ALIST
 159 (let* ((alist '((1 . 2) (3 . 4)))
 160        (copy (copy-alist alist)))
 161   (test (not (eql alist copy)))
 162   (test (not (eql (car alist) (car copy))))
 163   (test (equal alist copy)))
 164
 165 ; ASSOC and RASSOC
 166 (let ((alist '((1 . 2) (3 . 4))))
 167   (test (equal (assoc  1 alist) '(1 . 2)))
 168   (test (equal (rassoc 2 alist) '(1 . 2)))
 169   (test (not   (assoc  2 alist)))
 170   (test (not   (rassoc 1 alist))))
 171
 172 ; MEMBER
 173 (test (equal (member 2 '(1 2 3)) '(2 3)))
 174 (test (not   (member 4 '(1 2 3))))
 175 (test (equal (member 4 '((1 . 2) (3 . 4)) :key #'cdr) '((3 . 4))))
 176 (test (member '(2) '((1) (2) (3)) :test #'equal))
 177
 178 ; ADJOIN
 179 (test (equal (adjoin 1 '(2 3))   '(1 2 3)))
 180 (test (equal (adjoin 1 '(1 2 3)) '(1 2 3)))
 181 (test (equal (adjoin '(1) '((1) (2)) :test #'equal) '((1) (2))))
 182
 183 ; INTERSECTION
 184 (test (equal (intersection '(1 2) '(2 3)) '(2)))
 185 (test (not (intersection '(1 2 3) '(4 5 6))))
 186 (test (equal (intersection '((1) (2)) '((2) (3)) :test #'equal) '((2))))
 187
 188 ; POP
 189 (test (let* ((foo '(1 2 3))
 190              (bar (pop foo)))
 191         (and (= bar 1)
 192              (= (car foo) 2))))
 193
 194 ;; MAPCAR
 195 (test (equal (mapcar #'+ '(1 2) '(3) '(4 5 6)) '(8)))
 196
 197 ;; MAPC
 198 (test (equal (mapc #'+ '(1 2) '(3) '(4 5 6)) '(1 2)))
 199 (test (let (foo)
 200         (mapc (lambda (x y z) (push (+ x y z) foo)) '(1 2) '(3) '(4 5 6))
 201         (equal foo '(8))))