source: trunk/source/tests/ansi-tests/mapcar.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 2.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Apr 20 07:22:16 2003
4;;;; Contains: Tests of MAPCAR
5
6(in-package :cl-test)
7
8(compile-and-load "cons-aux.lsp")
9
10(deftest mapcar.1
11  (mapcar #'1+ nil)
12  nil)
13
14(deftest mapcar.2
15  (let* ((x (copy-list '(1 2 3 4)))
16         (xcopy (make-scaffold-copy x)))
17    (let ((result (mapcar #'1+ x)))
18      (and (check-scaffold-copy x xcopy)
19           result)))
20  (2 3 4 5))
21
22(deftest mapcar.3
23  (let* ((n 0)
24         (x (copy-list '(a b c d)))
25         (xcopy (make-scaffold-copy x)))
26    (let ((result
27           (mapcar #'(lambda (y) (declare (ignore y)) (incf n))
28                   x)))
29      (and (check-scaffold-copy x xcopy)
30           result)))
31  (1 2 3 4))
32
33(deftest mapcar.4
34  (let* ((n 0)
35         (x (copy-list '(a b c d)))
36         (xcopy (make-scaffold-copy x))
37         (x2 (copy-list '(a b c d e f)))
38         (x2copy (make-scaffold-copy x2))
39         (result
40          (mapcar #'(lambda (y z) (declare (ignore y z)) (incf n))
41                  x x2)))
42    (and (check-scaffold-copy x xcopy)
43         (check-scaffold-copy x2 x2copy)
44         (list result n)))
45  ((1 2 3 4) 4))
46 
47(deftest mapcar.5
48  (let* ((n 0)
49         (x (copy-list '(a b c d)))
50         (xcopy (make-scaffold-copy x))
51         (x2 (copy-list '(a b c d e f)))
52         (x2copy (make-scaffold-copy x2))
53         (result
54          (mapcar #'(lambda (y z) (declare (ignore y z)) (incf n))
55                  x2 x)))
56    (and (check-scaffold-copy x xcopy)
57         (check-scaffold-copy x2 x2copy)
58         (list result n)))
59  ((1 2 3 4) 4))
60
61(deftest mapcar.6
62 (let* ((x (copy-list '(a b c d e f g h)))
63         (xcopy (make-scaffold-copy x)))
64    (setf *mapc.6-var* nil)
65    (let ((result (mapcar 'mapc.6-fun x)))
66      (and (check-scaffold-copy x xcopy)
67           (list *mapc.6-var* result))))
68 ((h g f e d c b a) (a b c d e f g h)))
69
70(deftest mapcar.order.1
71  (let ((i 0) x y z)
72    (values
73     (mapcar (progn (setf x (incf i))
74                    #'list)
75             (progn (setf y (incf i))
76                    '(a b c))
77             (progn (setf z (incf i))
78                    '(1 2 3)))
79     i x y z))
80  ((a 1) (b 2) (c 3))
81  3 1 2 3)
82
83(def-fold-test mapcar.fold.1 (mapcar 'identity '(a b c d)))
84(def-fold-test mapcar.fold.2 (mapcar 'not '(t nil nil t t)))
85
86;;; Error tests
87
88(deftest mapcar.error.1
89  (check-type-error #'(lambda (x) (mapcar #'identity x)) #'listp)
90  nil)
91
92(deftest mapcar.error.2
93  (signals-error (mapcar) program-error)
94  t)
95
96(deftest mapcar.error.3
97  (signals-error (mapcar #'append) program-error)
98  t)
99
100(deftest mapcar.error.4
101  (signals-error (locally (mapcar #'identity 1) t) type-error)
102  t)
103
104(deftest mapcar.error.5
105  (signals-error (mapcar #'car '(a b c)) type-error)
106  t)
107
108(deftest mapcar.error.6
109  (signals-error (mapcar #'cons '(a b c)) program-error)
110  t)
111
112(deftest mapcar.error.7
113  (signals-error (mapcar #'cons '(a b c) '(1 2 3) '(4 5 6)) program-error)
114  t)
115
116(deftest mapcar.error.8
117  (signals-error (mapcar #'identity (list* 1 2 3 4)) type-error)
118  t)
Note: See TracBrowser for help on using the repository browser.