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

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

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

File size: 8.2 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Sep  4 22:53:51 2002
4;;;; Contains: Tests for CONCATENATE
5
6(in-package :cl-test)
7
8(deftest concatenate.1
9  (concatenate 'list)
10  nil)
11
12(deftest concatenate.2
13  (let* ((orig (list 'a 'b 'c 'd 'e))
14         (copy (concatenate 'list orig)))
15    (values
16     copy
17     (intersection (loop for e on orig collect e)
18                   (loop for e on copy collect e)
19                   :test #'eq)))
20  (a b c d e)
21  nil)
22
23(deftest concatenate.3
24  (concatenate 'list "")
25  nil)
26
27(deftest concatenate.4
28  (concatenate 'list "abcd" '(x y z) nil #*1101 #())
29  (#\a #\b #\c #\d x y z 1 1 0 1))
30
31(deftest concatenate.5
32  (concatenate 'vector)
33  #())
34
35(deftest concatenate.6
36  (concatenate 'vector nil "abcd" '(x y z) nil #*1101 #())
37  #(#\a #\b #\c #\d x y z 1 1 0 1))
38
39(deftest concatenate.7
40  (let* ((orig (vector 'a 'b 'c 'd 'e))
41         (copy (concatenate 'vector orig)))
42    (values
43     copy
44     (eqt copy orig)))
45  #(a b c d e)
46  nil)
47
48(deftest concatenate.8
49  (concatenate 'simple-vector '(a b c) #(1 2 3))
50  #(a b c 1 2 3))
51
52(deftest concatenate.9
53  (concatenate 'simple-vector)
54  #())
55
56(deftest concatenate.10
57  (concatenate 'bit-vector nil)
58  #*)
59
60(deftest concatenate.11
61  (concatenate 'bit-vector)
62  #*)
63
64(deftest concatenate.12
65  (concatenate 'bit-vector '(0 1 1) nil #(1 0 1) #())
66  #*011101)
67
68(deftest concatenate.13
69  (concatenate 'simple-bit-vector nil)
70  #*)
71
72(deftest concatenate.14
73  (concatenate 'simple-bit-vector)
74  #*)
75
76(deftest concatenate.15
77  (concatenate 'simple-bit-vector '(0 1 1) nil #(1 0 1) #())
78  #*011101)
79
80(deftest concatenate.16
81  (concatenate 'string "abc" '(#\d #\e) nil #() "fg")
82  "abcdefg")
83
84(deftest concatenate.17
85  (concatenate 'simple-string "abc" '(#\d #\e) nil #() "fg")
86  "abcdefg")
87
88(deftest concatenate.18
89  (concatenate '(vector * *) '(a b c) '(d e f) #(g h))
90  #(a b c d e f g h))
91
92(deftest concatenate.18a
93  (concatenate '(vector *) '(a b c) '(d e f) #(g h))
94  #(a b c d e f g h))
95
96(deftest concatenate.18b
97  (concatenate '(vector) '(a b c) '(d e f) #(g h))
98  #(a b c d e f g h))
99
100(deftest concatenate.18c
101  (concatenate '(simple-vector *) '(a b c) '(d e f) #(g h))
102  #(a b c d e f g h))
103
104(deftest concatenate.18d
105  (concatenate '(simple-vector) '(a b c) '(d e f) #(g h))
106  #(a b c d e f g h))
107
108(deftest concatenate.19
109  (concatenate '(vector * 8) '(a b c) '(d e f) #(g h))
110  #(a b c d e f g h))
111
112(deftest concatenate.20
113  (concatenate '(vector symbol 8) '(a b c) '(d e f) #(g h))
114  #(a b c d e f g h))
115
116(deftest concatenate.21
117  (concatenate '(vector symbol) '(a b c) '(d e f) #(g h))
118  #(a b c d e f g h))
119
120(deftest concatenate.22
121  (concatenate '(vector symbol *) '(a b c) '(d e f) #(g h))
122  #(a b c d e f g h))
123
124(deftest concatenate.23
125  (concatenate 'cons '(a b c) '(d e f))
126  (a b c d e f))
127
128(deftest concatenate.24
129  (concatenate 'null nil nil)
130  nil)
131
132;;; Tests on vectors with fill pointers
133
134(deftest concatenate.25
135  (let ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)
136                       :fill-pointer 5)))
137    (concatenate 'list x x))
138  (a b c d e a b c d e))
139
140(deftest concatenate.26
141  (let ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)
142                       :fill-pointer 5)))
143    (concatenate 'list x))
144  (a b c d e))
145
146(deftest concatenate.27
147  (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)
148                       :fill-pointer 5))
149         (result (concatenate 'vector x)))
150    (values (not (simple-vector-p result))
151            result))
152  nil
153  #(a b c d e))
154
155(deftest concatenate.28
156  (let* ((x (make-array '(10) :initial-contents "abcdefghij"
157                        :fill-pointer 5 :element-type 'character)))
158    (values
159     (concatenate 'string x '(#\z))
160     (concatenate 'string '(#\z) x)
161     (concatenate 'string x x)
162     (concatenate 'string x)
163     (not (simple-string-p (concatenate 'string x)))
164     ))
165  "abcdez"
166  "zabcde"
167  "abcdeabcde"
168  "abcde"
169  nil)
170
171(deftest concatenate.29
172  (let* ((x (make-array '(10) :initial-contents "abcdefghij"
173                        :fill-pointer 5 :element-type 'base-char)))
174    (values
175     (concatenate 'string x '(#\z))
176     (concatenate 'string '(#\z) x)
177     (concatenate 'string x x)
178     (concatenate 'string x)
179     (not (simple-string-p (concatenate 'string x)))
180     ))
181  "abcdez"
182  "zabcde"
183  "abcdeabcde"
184  "abcde"
185  nil)
186
187(deftest concatenate.30
188  (let* ((x (make-array '(10) :initial-contents #*0110010111
189                        :fill-pointer 5 :element-type 'bit)))
190    (values
191     (concatenate 'bit-vector x '(0))
192     (concatenate '(bit-vector) '(0) x)
193     (concatenate '(bit-vector 10) x x)
194     (concatenate '(bit-vector *) x)
195     (not (simple-bit-vector-p (concatenate 'bit-vector x)))
196     ))
197  #*011000
198  #*001100
199  #*0110001100
200  #*01100
201  nil)
202
203(deftest concatenate.30a
204  (let* ((x (make-array '(10) :initial-contents #*0110010111
205                        :fill-pointer 5 :element-type 'bit)))
206    (values
207     (concatenate 'simple-bit-vector x '(0))
208     (concatenate 'simple-bit-vector '(0) x)
209     (concatenate 'simple-bit-vector x x)
210     (concatenate 'simple-bit-vector x)
211     (not (simple-bit-vector-p (concatenate 'bit-vector x)))
212     ))
213  #*011000
214  #*001100
215  #*0110001100
216  #*01100
217  nil)
218
219(deftest concatenate.31
220  :notes (:nil-vectors-are-strings)
221  (concatenate 'string "abc" (make-array '(0) :element-type nil) "def")
222  "abcdef")
223
224(deftest concatenate.32
225  :notes (:nil-vectors-are-strings)
226  (concatenate '(array nil (*)))
227  "")
228
229(deftest concatenate.33
230  (do-special-strings
231   (s "abc" nil)
232   (assert (string= (concatenate 'string s s s) "abcabcabc"))
233   (assert (string= (concatenate 'string "xy" s) "xyabc"))
234   (assert (string= (concatenate 'simple-string s "z" s "w" s) "abczabcwabc"))
235   (assert (string= (concatenate 'base-string s "z" s "w" s) "abczabcwabc"))
236   (assert (string= (concatenate 'simple-base-string s "z" s "w" s) "abczabcwabc"))
237   (assert (string= (concatenate '(vector character) s "z" s "w" s) "abczabcwabc")))
238  nil)
239
240(deftest concatenate.34
241  (concatenate 'simple-string "abc" "def")
242  "abcdef")
243                     
244(deftest concatenate.35
245  (concatenate '(simple-string) "abc" "def")
246  "abcdef")
247                     
248(deftest concatenate.36
249  (concatenate '(simple-string *) "abc" "def")
250  "abcdef")
251                     
252(deftest concatenate.37
253  (concatenate '(simple-string 6) "abc" "def")
254  "abcdef")
255                     
256(deftest concatenate.38
257  (concatenate '(string) "abc" "def")
258  "abcdef")
259                     
260(deftest concatenate.39
261  (concatenate '(string *) "abc" "def")
262  "abcdef")
263                     
264(deftest concatenate.40
265  (concatenate '(string 6) "abc" "def")
266  "abcdef")
267
268;;; Order of evaluation tests
269                     
270(deftest concatenate.order.1
271  (let ((i 0) w x y z)
272    (values
273     (concatenate (progn (setf w (incf i)) 'string)
274                  (progn (setf x (incf i)) "abc")
275                  (progn (setf y (incf i)) "def")
276                  (progn (setf z (incf i)) "ghi"))
277     i w x y z))
278  "abcdefghi" 4 1 2 3 4)
279
280(deftest concatenate.order.2
281  (let ((i 0) x y z)
282    (values
283     (concatenate 'string
284                  (progn (setf x (incf i)) "abc")
285                  (progn (setf y (incf i)) "def")
286                  (progn (setf z (incf i)) "ghi"))
287     i x y z))
288  "abcdefghi" 3 1 2 3)
289
290;;; Constant folding tests
291
292(def-fold-test concatenate.fold.1 (concatenate 'list '(a b) '(c d)))
293(def-fold-test concatenate.fold.2 (concatenate 'vector '(a b) '(c d)))
294(def-fold-test concatenate.fold.3 (concatenate 'bit-vector '(0 0) '(1 0 1)))
295(def-fold-test concatenate.fold.4 (concatenate 'string "ab" "cd"))
296(def-fold-test concatenate.fold.5 (concatenate 'list '(a b c d)))
297(def-fold-test concatenate.fold.6 (concatenate 'vector #(a b c d)))
298(def-fold-test concatenate.fold.7 (concatenate 'bit-vector #*110101101))
299(def-fold-test concatenate.fold.8 (concatenate 'string "abcdef"))
300 
301;;; Error tests
302
303(deftest concatenate.error.1
304  (signals-error (concatenate 'sequence '(a b c)) error)
305  t)
306
307(deftest concatenate.error.2
308  (signals-error-always (concatenate 'fixnum '(a b c d e)) error)
309  t t)
310
311(deftest concatenate.error.3
312  (signals-error (concatenate '(vector * 3) '(a b c d e))
313                 type-error)
314  t)
315
316(deftest concatenate.error.4
317  (signals-error (concatenate) program-error)
318  t)
319
320(deftest concatenate.error.5
321  (signals-error (locally (concatenate '(vector * 3) '(a b c d e)) t)
322                 type-error)
323  t)
324
325(deftest concatenate.error.6
326  :notes (:result-type-element-type-by-subtype)
327  (let ((type '(or (vector bit) (vector t))))
328    (if (subtypep type 'vector)
329        (eval `(signals-error-always (concatenate ',type '(0 1 0) '(1 1 0)) error))
330      (values t t)))
331  t t)
332
Note: See TracBrowser for help on using the repository browser.