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

(in-package :cl-test)

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

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)