cons-test-07.lsp 4.46 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Mar 28 07:35:15 1998
;;;; Contains: Testing of CL Features related to "CONS", part 7

(in-package :cl-test)

(declaim (optimize (safety 3)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; nconc

13
(deftest nconc.1
14
  (nconc)
15
16
  nil)

17
(deftest nconc.2
18
  (nconc (copy-tree '(a b c d e f)))
19
20
  (a b c d e f))

pfdietz's avatar
pfdietz committed
21
22
23
;;; (deftest nconc.3
;;;  (nconc 1)
;;;  1)
24

25
(deftest nconc.4
26
27
28
29
30
31
32
33
  (let ((x (list 'a 'b 'c))
	(y (list 'd 'e 'f)))
    (let ((ycopy (make-scaffold-copy y)))
      (let ((result (nconc x y)))
	(and
	 (check-scaffold-copy y ycopy)
	 (eqt (cdddr x) y)
	 result))))
34
35
  (a b c d e f))

36
(deftest nconc.5
37
38
39
40
41
  (let ((x (list 'a 'b 'c)))
    (nconc x x)
    (and
     (eqt (cdddr x) x)
     (null (list-length x))))
42
43
  t)

44
(deftest nconc.6
45
46
47
48
49
50
51
52
53
  (let ((x (list 'a 'b 'c))
	(y (list 'd 'e 'f 'g 'h))
	(z (list 'i 'j 'k)))
    (let ((result (nconc x y z 'foo)))
      (and
       (eqt (nthcdr 3 x) y)
       (eqt (nthcdr 5 y) z)
       (eqt (nthcdr 3 z) 'foo)
       result)))
54
55
  (a b c d e f g h i j k . foo))

56
(deftest nconc.7
57
58
59
60
61
62
  (nconc (copy-tree '(a . b))
	 (copy-tree '(c . d))
	 (copy-tree '(e . f))
	 'foo)
  (a c e . foo))

63
(deftest nconc.order.1
64
65
66
67
68
69
70
  (let ((i 0) x y z)
    (values
     (nconc (progn (setf x (incf i)) (copy-list '(a b c)))
	    (progn (setf y (incf i)) (copy-list '(d e f)))
	    (progn (setf z (incf i)) (copy-list '(g h i))))
     i x y z))
  (a b c d e f g h i) 3 1 2 3)
71
72
73
74

(deftest nconc.order.2
  (let ((i 0))
    (values
pfdietz's avatar
pfdietz committed
75
     (nconc (list 'a) (incf i))
76
     i))
pfdietz's avatar
pfdietz committed
77
  (a . 1) 1)
78

79
80
81
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; append

82
83
(deftest append.1
  (append)
84
85
  nil)

86
87
(deftest append.2
  (append 'x)
88
89
  x)

90
91
92
93
94
95
96
97
98
99
(deftest append.3
  (let ((x (list 'a 'b 'c 'd))
	(y (list 'e 'f 'g)))
    (let ((xcopy (make-scaffold-copy x))
	  (ycopy (make-scaffold-copy y)))
      (let ((result (append x y)))
	(and
	 (check-scaffold-copy x xcopy)
	 (check-scaffold-copy y ycopy)
	 result))))
100
101
  (a b c d e f g))

102
103
104
105
(deftest append.4
  (append (list 'a) (list 'b) (list 'c)
	  (list 'd) (list 'e) (list 'f)
	  (list 'g) 'h)
106
107
  (a b c d e f g . h))

108
109
(deftest append.5
  (append nil nil nil nil nil nil nil nil 'a)
110
111
  a)

112
113
(deftest append.6
  (append-6-body)
114
115
  0)

116
(deftest append.order.1
117
118
119
120
121
122
123
  (let ((i 0) x y z)
    (values
     (append (progn (setf x (incf i)) (copy-list '(a b c)))
	     (progn (setf y (incf i)) (copy-list '(d e f)))
	     (progn (setf z (incf i)) (copy-list '(g h i))))
     i x y z))
  (a b c d e f g h i) 3 1 2 3)
124

125
126
127
128
(deftest append.order.2
  (let ((i 0)) (values (append (incf i)) i))
  1 1)

129
130
131
132
(deftest append.error.1
  (classify-error (append '(a . b) '(z)))
  type-error)

133
134
135
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; revappend

136
(deftest revappend.1
137
138
139
140
141
142
143
144
145
    (let* ((x (list 'a 'b 'c))
	   (y (list 'd 'e 'f))
	   (xcopy (make-scaffold-copy x))
	   (ycopy (make-scaffold-copy y))
	   )
      (let ((result (revappend x y)))
	(and
	 (check-scaffold-copy x xcopy)
	 (check-scaffold-copy y ycopy)
146
	 (eqt (cdddr result) y)
147
148
149
	 result)))
  (c b a d e f))

150
(deftest revappend.2
151
152
153
    (revappend (copy-tree '(a b c d e)) 10)
  (e d c b a . 10))

154
(deftest revappend.3
155
156
157
    (revappend nil 'a)
  a)

158
(deftest revappend.4
159
160
161
    (revappend (copy-tree '(a (b c) d)) nil)
  (d (b c) a))

162
(deftest revappend.order.1
163
164
165
166
167
168
169
  (let ((i 0) x y)
    (values
     (revappend (progn (setf x (incf i)) (copy-list '(a b c)))
		(progn (setf y (incf i)) (copy-list '(d e f))))
     i x y))
  (c b a d e f) 2 1 2)

170
171
172
173
174
175
176
177
178
179
180
181
(deftest revappend.error.1
  (classify-error (revappend))
  program-error)

(deftest revappend.error.2
  (classify-error (revappend nil))
  program-error)

(deftest revappend.error.3
  (classify-error (revappend nil nil nil))
  program-error)

182
183
184
185
(deftest revappend.error.4
  (classify-error (revappend '(a . b) '(z)))
  type-error)

186
187
188
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; nreconc

189
(deftest nreconc.1
190
191
192
193
194
  (let* ((x (list 'a 'b 'c))
	 (y (copy-tree '(d e f)))
	 (result (nreconc x y)))
    (and (equal y '(d e f))
	 result))
195
196
  (c b a d e f))

197
(deftest nreconc.2
198
  (nreconc nil 'a)
199
  a)
200

201
(deftest nreconc.order.1
202
203
204
205
206
207
208
  (let ((i 0) x y)
    (values
     (nreconc (progn (setf x (incf i)) (copy-list '(a b c)))
	      (progn (setf y (incf i)) (copy-list '(d e f))))
     i x y))
  (c b a d e f) 2 1 2)

209
210
211
212
213
214
215
216
217
218
219
(deftest nreconc.error.1
  (classify-error (nreconc))
  program-error)

(deftest nreconc.error.2
  (classify-error (nreconc nil))
  program-error)

(deftest nreconc.error.3
  (classify-error (nreconc nil nil nil))
  program-error)
220
221
222
223

(deftest nreconc.error.4
  (classify-error (nreconc (cons 'a 'b) (list 'z)))
  type-error)