source: trunk/source/tests/ansi-tests/copy-seq.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: 5.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Nov  2 21:38:08 2002
4;;;; Contains: Tests for COPY-SEQ
5
6(in-package :cl-test)
7
8;;; This function is extensively used elsewhere, but is tested again
9;;; here for completeness.
10
11(deftest copy-seq.1
12  (copy-seq nil)
13  nil)
14
15(deftest copy-seq.2
16  (let* ((s1 '(a b c))
17         (s2 (check-values (copy-seq s1))))
18    (and (not (eql s1 s2))
19         (equalt s1 s2)))
20  t)
21
22(deftest copy-seq.3
23  (let* ((s1 #(a b c))
24         (s2 (check-values (copy-seq s1))))
25    (and (not (eql s1 s2)) s2))
26  #(a b c))
27
28(deftest copy-seq.4
29  (let* ((s1 (make-array '(4) :initial-contents '(a b c d)
30                         :adjustable t))
31         (s2 (check-values (copy-seq s1))))
32    (and (not (eql s1 s2))
33         (simple-vector-p s2)
34         s2))
35  #(a b c d))
36
37
38(deftest copy-seq.5
39  (let* ((s1 (make-array '(4) :initial-contents '(a b c d)
40                         :fill-pointer 3))
41         (s2 (check-values (copy-seq s1))))
42    (and (not (eql s1 s2))
43         (simple-vector-p s2)
44         s2))
45  #(a b c))
46
47(deftest copy-seq.6
48  (let* ((a1 (make-array '(6) :initial-contents '(a b c d e f)))
49         (a2 (make-array '(4) :displaced-to a1
50                         :displaced-index-offset 1))
51         (s2 (check-values (copy-seq a2))))
52    (and (not (eql a2 s2))
53         (simple-vector-p s2)
54         s2))
55  #(b c d e))
56
57(deftest copy-seq.7
58  (let* ((s1 (make-array '(4)
59                         :element-type 'base-char
60                         :initial-contents '(#\a #\b #\c #\d)
61                         :adjustable t))
62         (s2 (check-values (copy-seq s1))))
63    (and (not (eql s1 s2))
64         (simple-string-p s2)
65         s2))
66  "abcd")
67
68
69(deftest copy-seq.8
70  (let* ((s1 (make-array '(4)
71                         :element-type 'base-char
72                         :initial-contents '(#\a #\b #\c #\d)
73                         :fill-pointer 3))
74         (s2 (check-values (copy-seq s1))))
75    (and (not (eql s1 s2))
76         (simple-string-p s2)
77         s2))
78  "abc")
79
80(deftest copy-seq.9
81  (let* ((a1 (make-array '(6) :initial-contents '(#\a #\b #\c #\d #\e #\f)
82                         :element-type 'base-char))
83         (a2 (make-array '(4) :displaced-to a1
84                         :element-type 'base-char
85                         :displaced-index-offset 1))
86         (s2 (check-values (copy-seq a2))))
87    (and (not (eql a2 s2))
88         (simple-string-p s2)
89         s2))
90  "bcde")
91
92(deftest copy-seq.10
93  (let*((s1 "abcd")
94        (s2 (check-values (copy-seq s1))))
95    (and (not (eql s1 s2))
96         s2))
97  "abcd")
98
99(deftest copy-seq.11
100  (let* ((s1 #*0010110)
101         (s2 (check-values (copy-seq s1))))
102    (and (not (eql s1 s2))
103         (simple-bit-vector-p s2)
104         s2))
105  #*0010110)
106
107(deftest copy-seq.12
108  (let* ((s1 (make-array '(4) :initial-contents '(0 0 1 0)
109                         :element-type 'bit
110                         :adjustable t))
111         (s2 (check-values (copy-seq s1))))
112    (and (not (eql s1 s2))
113         (simple-bit-vector-p s2)
114         s2))
115  #*0010)
116
117(deftest copy-seq.13
118  (let* ((s1 (make-array '(4) :initial-contents '(0 0 1 0)
119                         :element-type 'bit
120                         :fill-pointer 3))
121         (s2 (check-values (copy-seq s1))))
122    (and (not (eql s1 s2))
123         (simple-bit-vector-p s2)
124         s2))
125  #*001)
126
127(deftest copy-seq.14
128  (let* ((a1 (make-array '(6) :initial-contents '(0 0 1 0 1 1)
129                         :element-type 'bit))
130         (a2 (make-array '(4) :displaced-to a1
131                         :displaced-index-offset 1
132                         :element-type 'bit))
133         (s2 (check-values (copy-seq a2))))
134    (and (not (eql a2 s2))
135         (simple-bit-vector-p s2)
136         s2))
137  #*0101)
138
139(deftest copy-seq.15
140  (copy-seq "")
141  "")
142
143(deftest copy-seq.16
144  (copy-seq #*)
145  #*)
146
147(deftest copy-seq.17
148  (copy-seq #())
149  #())
150
151(deftest copy-seq.18
152  (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)))
153         (y (check-values (copy-seq x))))
154    (equal-array x y))
155  t)
156
157(deftest copy-seq.19
158  :notes (:nil-vectors-are-strings)
159  (copy-seq (make-array '(0) :element-type nil))
160  "")
161
162;;; Specialized string tests
163
164(deftest copy-seq.20
165  (do-special-strings
166   (s "abcde" nil)
167   (let ((s2 (copy-seq s)))
168     (assert (typep s2 'simple-array))
169     (assert (string= s s2))
170     (assert (equal (array-element-type s) (array-element-type s2)))))
171  nil)
172
173;;; Specialized vector tests
174
175(deftest copy-seq.21
176  (let ((v0 #(1 1 0 1 1 2)))
177    (do-special-integer-vectors
178     (v v0 nil)
179     (let ((v2 (copy-seq v)))
180       (assert (typep v2 'simple-array))
181       (assert (equalp v v2))
182       (assert (equalp v v0))
183       (assert (equal (array-element-type v) (array-element-type v2))))))
184  nil)
185
186(deftest copy-seq.22
187  (let ((v0 #(-1 1 1 0 1 -1 0)))
188    (do-special-integer-vectors
189     (v v0 nil)
190     (let ((v2 (copy-seq v)))
191       (assert (typep v2 'simple-array))
192       (assert (equalp v v2))
193       (assert (equalp v v0))
194       (assert (equal (array-element-type v) (array-element-type v2))))))
195  nil)
196
197(deftest copy-seq.23
198  (loop for type in '(short-float single-float long-float double-float)
199        for len = 10
200        for vals = (loop for i from 1 to len collect (coerce i type))
201        for vec = (make-array len :element-type type :initial-contents vals)
202        for result = (copy-seq vec)
203        unless (and (= (length result) len)
204                    (equal (array-element-type vec) (array-element-type result))
205                    (equalp vec result))
206        collect (list type vals result))
207  nil)
208
209(deftest copy-seq.24
210  (loop for etype in '(short-float single-float long-float double-float)
211        for type = `(complex ,etype)
212        for len = 10
213        for vals = (loop for i from 1 to len collect (complex (coerce i etype)
214                                                              (coerce (- i) etype)))
215        for vec = (make-array len :element-type type :initial-contents vals)
216        for result = (copy-seq vec)
217        unless (and (= (length result) len)
218                    (equal (array-element-type vec) (array-element-type result))
219                    (equalp vec result))
220        collect (list type vals result))
221  nil)
222
223;;; Order of evaluation test
224
225(deftest copy-seq.order.1
226  (let ((i 0))
227    (values (copy-seq (progn (incf i) "abc")) i))
228  "abc" 1)
229
230(def-fold-test copy-seq.fold.1 (copy-seq '(a b c)))
231(def-fold-test copy-seq.fold.2 (copy-seq #(a b c)))
232(def-fold-test copy-seq.fold.3 (copy-seq #*01101100))
233(def-fold-test copy-seq.fold.4 (copy-seq "abcdef"))
234
235;;; Error tests
236
237(deftest copy-seq.error.1
238  (check-type-error #'copy-seq #'sequencep)
239  nil)
240
241(deftest copy-seq.error.4
242  (signals-error (copy-seq) program-error)
243  t)
244
245(deftest copy-seq.error.5
246  (signals-error (copy-seq "abc" 2 nil) program-error)
247  t)
248
249(deftest copy-seq.error.6
250  (signals-error (locally (copy-seq 10) t) type-error)
251  t)
Note: See TracBrowser for help on using the repository browser.