maplist.lsp 3.27 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Apr 20 07:24:00 2003
;;;; Contains: Tests of MAPLIST

(in-package :cl-test)

8 9
(compile-and-load "cons-aux.lsp")

10 11 12 13 14 15
(deftest maplist.1
  (maplist #'list nil)
  nil)

(deftest maplist.2
  (let* ((x (copy-list '(a b c)))
sds's avatar
sds committed
16 17
         (xcopy (make-scaffold-copy x))
         (result (maplist #'identity x)))
18
    (and (check-scaffold-copy x xcopy)
sds's avatar
sds committed
19
         result))
20 21 22 23
  ((a b c) (b c) (c)))

(deftest maplist.3
  (let* ((x (copy-list '(a b c d)))
sds's avatar
sds committed
24 25 26 27 28
         (y (copy-list '(1 2 3 4)))
         (xcopy (make-scaffold-copy x))
         (ycopy (make-scaffold-copy y))
         (result
          (maplist #'append x y)))
29 30 31 32 33 34 35 36 37 38 39
    (and
     (check-scaffold-copy x xcopy)
     (check-scaffold-copy y ycopy)
     result))
  ((a b c d 1 2 3 4)
   (b c d 2 3 4)
   (c d 3 4)
   (d 4)))

(deftest maplist.4
  (let* ((x (copy-list '(a b c d)))
sds's avatar
sds committed
40 41 42 43 44
         (y (copy-list '(1 2 3 4 5)))
         (xcopy (make-scaffold-copy x))
         (ycopy (make-scaffold-copy y))
         (result
          (maplist #'append x y)))
45 46 47 48 49 50 51 52 53 54 55
    (and
     (check-scaffold-copy x xcopy)
     (check-scaffold-copy y ycopy)
     result))
  ((a b c d 1 2 3 4 5)
   (b c d 2 3 4 5)
   (c d 3 4 5)
   (d 4 5)))

(deftest maplist.5
  (let* ((x (copy-list '(a b c d e)))
sds's avatar
sds committed
56 57 58 59 60
         (y (copy-list '(1 2 3 4)))
         (xcopy (make-scaffold-copy x))
         (ycopy (make-scaffold-copy y))
         (result
          (maplist #'append x y)))
61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
    (and
     (check-scaffold-copy x xcopy)
     (check-scaffold-copy y ycopy)
     result))
  ((a b c d e 1 2 3 4)
   (b c d e 2 3 4)
   (c d e 3 4)
   (d e 4)))

(deftest maplist.6
  (maplist 'append '(a b c) '(1 2 3))
  ((a b c 1 2 3) (b c 2 3) (c 3)))

(deftest maplist.7
  (maplist #'(lambda (x y) (nth (car x) y))
sds's avatar
sds committed
76 77 78
           '(0 1 0 1 0 1 0)
           '(a b c d e f g)
           )
79 80 81 82 83 84 85
  (a c c e e g g))

(deftest maplist.order.1
  (let ((i 0) x y z)
    (values
     (maplist
      (progn
sds's avatar
sds committed
86 87
        (setf x (incf i))
        #'(lambda (x y) (declare (ignore x)) (car y)))
88
      (progn
sds's avatar
sds committed
89 90
        (setf y (incf i))
        '(a b c))
91
      (progn
sds's avatar
sds committed
92 93
        (setf z (incf i))
             '(1 2 3)))
94 95 96
     i x y z))
  (1 2 3) 3 1 2 3)

pfdietz's avatar
pfdietz committed
97 98 99 100 101
(def-fold-test maplist.fold.1 (maplist 'car '(a b c d e)))
(def-fold-test maplist.fold.2 (maplist #'cadr '(a b c d e)))

;;; Error tests

102
(deftest maplist.error.1
pfdietz's avatar
pfdietz committed
103 104
  (check-type-error #'(lambda (x) (maplist #'identity x)) #'listp)
  nil)
105 106

(deftest maplist.error.2
107 108
  (signals-error (maplist #'identity 1) type-error)
  t)
109 110

(deftest maplist.error.3
111 112
  (signals-error (maplist #'identity 1.1323) type-error)
  t)
113 114

(deftest maplist.error.4
115 116
  (signals-error (maplist #'identity "abcde") type-error)
  t)
117 118

(deftest maplist.error.5
119 120
  (signals-error (maplist) program-error)
  t)
121 122

(deftest maplist.error.6
123 124
  (signals-error (maplist #'append) program-error)
  t)
125 126

(deftest maplist.error.7
127 128
  (signals-error (locally (maplist #'identity 'a) t) type-error)
  t)
129 130

(deftest maplist.error.8
131 132
  (signals-error (maplist #'caar '(a b c)) type-error)
  t)
133 134

(deftest maplist.error.9
135 136
  (signals-error (maplist #'cons '(a b c)) program-error)
  t)
137 138

(deftest maplist.error.10
139
  (signals-error (maplist #'cons '(a b c) '(1 2 3) '(4 5 6))
sds's avatar
sds committed
140
                 program-error)
141
  t)
142 143

(deftest maplist.error.11
144
  (signals-error (maplist #'identity (list* (list 1) (list 2) 3))
sds's avatar
sds committed
145
                 type-error)
146 147
  t)

148