← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/mapcan.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/mapcan.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sun Apr 20 07:22:46 2003
 
4
;;;; Contains: Tests of MAPCAN
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(compile-and-load "cons-aux.lsp")
 
9
 
 
10
(deftest mapcan.1
 
11
  (mapcan #'list nil)
 
12
  nil)
 
13
 
 
14
(deftest mapcan.2
 
15
  (mapcan #'list (copy-list '(a b c d e f)))
 
16
  (a b c d e f))
 
17
 
 
18
(deftest mapcan.3
 
19
  (let* ((x (list 'a 'b 'c 'd))
 
20
         (xcopy (make-scaffold-copy x))
 
21
         (result (mapcan #'list x)))
 
22
    (and
 
23
     (= (length x) (length result))
 
24
     (check-scaffold-copy x xcopy)
 
25
     (loop
 
26
      for e1 on x
 
27
      and e2 on result
 
28
      count (or (eqt e1 e2) (not (eql (car e1) (car e2)))))))
 
29
  0)
 
30
 
 
31
(deftest mapcan.4
 
32
  (mapcan #'list
 
33
          (copy-list '(1 2 3 4))
 
34
          (copy-list '(a b c d)))
 
35
  (1 a 2 b 3 c 4 d))
 
36
 
 
37
(deftest mapcan.5
 
38
  (mapcan #'(lambda (x y) (make-list y :initial-element x))
 
39
          (copy-list '(a b c d))
 
40
          (copy-list '(1 2 3 4)))
 
41
  (a b b c c c d d d d))
 
42
 
 
43
(defvar *mapcan.6-var* nil)
 
44
(defun mapcan.6-fun (x)
 
45
  (push x *mapcan.6-var*)
 
46
  (copy-list *mapcan.6-var*))
 
47
 
 
48
(deftest mapcan.6
 
49
  (progn
 
50
    (setf *mapcan.6-var* nil)
 
51
    (mapcan 'mapcan.6-fun (copy-list '(a b c d))))
 
52
  (a b a c b a d c b a))
 
53
 
 
54
(deftest mapcan.order.1
 
55
  (let ((i 0) x y z)
 
56
    (values
 
57
     (mapcan (progn (setf x (incf i))
 
58
                    #'list)
 
59
             (progn (setf y (incf i))
 
60
                    '(a b c))
 
61
             (progn (setf z (incf i))
 
62
                    '(1 2 3)))
 
63
     i x y z))
 
64
  (a 1 b 2 c 3)
 
65
  3 1 2 3)
 
66
 
 
67
(deftest mapcan.8
 
68
  (mapcan #'(lambda (x y) (make-list y :initial-element x))
 
69
          (copy-list '(a b c d))
 
70
          (copy-list '(1 2 3 4 5 6)))
 
71
  (a b b c c c d d d d))
 
72
 
 
73
(deftest mapcan.9
 
74
  (mapcan #'(lambda (x y) (make-list y :initial-element x))
 
75
          (copy-list '(a b c d e f))
 
76
          (copy-list '(1 2 3 4)))
 
77
  (a b b c c c d d d d))
 
78
 
 
79
(deftest mapcan.10
 
80
  (mapcan #'list
 
81
          (copy-list '(a b c d))
 
82
          (copy-list '(1 2 3 4))
 
83
          nil)
 
84
  nil)
 
85
 
 
86
(deftest mapcan.11
 
87
  (mapcan (constantly 1) (list 'a))
 
88
  1)
 
89
 
 
90
(deftest mapcan.error.1
 
91
  (signals-error (mapcan #'identity 1) type-error)
 
92
  t)
 
93
 
 
94
(deftest mapcan.error.2
 
95
  (signals-error (mapcan) program-error)
 
96
  t)
 
97
 
 
98
(deftest mapcan.error.3
 
99
  (signals-error (mapcan #'append) program-error)
 
100
  t)
 
101
 
 
102
(deftest mapcan.error.4
 
103
  (signals-error (locally (mapcan #'identity 1) t) type-error)
 
104
  t)
 
105
 
 
106
(deftest mapcan.error.5
 
107
  (signals-error (mapcan #'car '(a b c)) type-error)
 
108
  t)
 
109
 
 
110
(deftest mapcan.error.6
 
111
  (signals-error (mapcan #'cons '(a b c)) program-error)
 
112
  t)
 
113
 
 
114
(deftest mapcan.error.7
 
115
  (signals-error (mapcan #'cons '(a b c) '(1 2 3) '(4 5 6))
 
116
                 program-error)
 
117
  t)
 
118
 
 
119
(deftest mapcan.error.8
 
120
  (signals-error (mapcan #'identity (list* (list 1) (list 2) 3))
 
121
                 type-error)
 
122
  t)