mapcar.lsp 2.91 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Apr 20 07:22:16 2003
;;;; Contains: Tests of MAPCAR

6

7

8

9

10 11 12 13 14 15
(deftest mapcar.1
  (mapcar #'1+ nil)
  nil)

(deftest mapcar.2
  (let* ((x (copy-list '(1 2 3 4)))
sds's avatar
sds committed
16
         (xcopy (make-scaffold-copy x)))
17 18
    (let ((result (mapcar #'1+ x)))
      (and (check-scaffold-copy x xcopy)
sds's avatar
sds committed
19
           result)))
20 21 22 23
  (2 3 4 5))

(deftest mapcar.3
  (let* ((n 0)
sds's avatar
sds committed
24 25
         (x (copy-list '(a b c d)))
         (xcopy (make-scaffold-copy x)))
26
    (let ((result
sds's avatar
sds committed
27 28
           (mapcar #'(lambda (y) (declare (ignore y)) (incf n))
                   x)))
29
      (and (check-scaffold-copy x xcopy)
sds's avatar
sds committed
30
           result)))
31 32 33 34
  (1 2 3 4))

(deftest mapcar.4
  (let* ((n 0)
sds's avatar
sds committed
35 36 37 38 39 40 41
         (x (copy-list '(a b c d)))
         (xcopy (make-scaffold-copy x))
         (x2 (copy-list '(a b c d e f)))
         (x2copy (make-scaffold-copy x2))
         (result
          (mapcar #'(lambda (y z) (declare (ignore y z)) (incf n))
                  x x2)))
42
    (and (check-scaffold-copy x xcopy)
sds's avatar
sds committed
43 44
         (check-scaffold-copy x2 x2copy)
         (list result n)))
45
  ((1 2 3 4) 4))
sds's avatar
sds committed
46

47 48
(deftest mapcar.5
  (let* ((n 0)
sds's avatar
sds committed
49 50 51 52 53 54 55
         (x (copy-list '(a b c d)))
         (xcopy (make-scaffold-copy x))
         (x2 (copy-list '(a b c d e f)))
         (x2copy (make-scaffold-copy x2))
         (result
          (mapcar #'(lambda (y z) (declare (ignore y z)) (incf n))
                  x2 x)))
56
    (and (check-scaffold-copy x xcopy)
sds's avatar
sds committed
57 58
         (check-scaffold-copy x2 x2copy)
         (list result n)))
59 60 61 62
  ((1 2 3 4) 4))

(deftest mapcar.6
 (let* ((x (copy-list '(a b c d e f g h)))
sds's avatar
sds committed
63
         (xcopy (make-scaffold-copy x)))
64 65 66
    (setf *mapc.6-var* nil)
    (let ((result (mapcar 'mapc.6-fun x)))
      (and (check-scaffold-copy x xcopy)
sds's avatar
sds committed
67
           (list *mapc.6-var* result))))
68 69 70 71 72 73
 ((h g f e d c b a) (a b c d e f g h)))

(deftest mapcar.order.1
  (let ((i 0) x y z)
    (values
     (mapcar (progn (setf x (incf i))
sds's avatar
sds committed
74 75 76 77 78
                    #'list)
             (progn (setf y (incf i))
                    '(a b c))
             (progn (setf z (incf i))
                    '(1 2 3)))
79 80 81 82
     i x y z))
  ((a 1) (b 2) (c 3))
  3 1 2 3)

pfdietz's avatar
pfdietz committed
83 84 85 86 87
(def-fold-test mapcar.fold.1 (mapcar 'identity '(a b c d)))
(def-fold-test mapcar.fold.2 (mapcar 'not '(t nil nil t t)))

;;; Error tests

88
(deftest mapcar.error.1
pfdietz's avatar
pfdietz committed
89 90
  (check-type-error #'(lambda (x) (mapcar #'identity x)) #'listp)
  nil)
91 92

(deftest mapcar.error.2
93 94
  (signals-error (mapcar) program-error)
  t)
95 96

(deftest mapcar.error.3
97 98
  (signals-error (mapcar #'append) program-error)
  t)
99 100

(deftest mapcar.error.4
101 102
  (signals-error (locally (mapcar #'identity 1) t) type-error)
  t)
103 104

(deftest mapcar.error.5
105 106
  (signals-error (mapcar #'car '(a b c)) type-error)
  t)
107 108

(deftest mapcar.error.6
109 110
  (signals-error (mapcar #'cons '(a b c)) program-error)
  t)
111 112

(deftest mapcar.error.7
113 114
  (signals-error (mapcar #'cons '(a b c) '(1 2 3) '(4 5 6)) program-error)
  t)
115 116

(deftest mapcar.error.8
117 118
  (signals-error (mapcar #'identity (list* 1 2 3 4)) type-error)
  t)