source: trunk/source/tests/ansi-tests/loop5.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: 6.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Nov  2 13:52:50 2002
4;;;; Contains: Tests of LOOP clause FOR-AS-ACROSS
5
6(in-package :cl-test)
7
8(deftest loop.5.1
9  (let ((x "abcd")) (loop for e across x collect e))
10  (#\a #\b #\c #\d))
11
12(deftest loop.5.2
13  (let ((x "abcd")) (loop for e across (the string x) collect e))
14  (#\a #\b #\c #\d))
15
16(deftest loop.5.3
17  (let ((x "abcd")) (loop for e across (the simple-string x) collect e))
18  (#\a #\b #\c #\d))
19
20(deftest loop.5.4
21  (loop for e across "abcd" collect e)
22  (#\a #\b #\c #\d))
23
24(deftest loop.5.5
25  (loop for e across "abcd"
26        for i from 1 to 3 collect e)
27  (#\a #\b #\c))
28
29(deftest loop.5.6
30  (loop for e of-type base-char across "abcd"
31        for i from 1 to 3 collect e)
32  (#\a #\b #\c))
33
34(deftest loop.5.7
35  (let ((x (make-array '(4) :initial-contents "abcd" :element-type 'base-char)))
36    (loop for e across (the base-string x) collect e))
37  (#\a #\b #\c #\d))
38
39(deftest loop.5.8
40  (let ((x "abcd")) (loop for e of-type character across x collect e))
41  (#\a #\b #\c #\d))
42
43(deftest loop.5.10
44  (let ((x #*00010110))
45    (loop for e across x collect e))
46  (0 0 0 1 0 1 1 0))
47
48(deftest loop.5.11
49  (let ((x #*00010110))
50    (loop for e across (the bit-vector x) collect e))
51  (0 0 0 1 0 1 1 0))
52
53(deftest loop.5.12
54  (let ((x #*00010110))
55    (loop for e across (the simple-bit-vector x) collect e))
56  (0 0 0 1 0 1 1 0))
57
58(deftest loop.5.13
59  (let ((x #*00010110))
60    (loop for e of-type bit across (the simple-bit-vector x) collect e))
61  (0 0 0 1 0 1 1 0))
62
63(deftest loop.5.14
64  (let ((x #*00010110))
65    (loop for e of-type bit across x
66          for i from 1 to 4 collect e))
67  (0 0 0 1))
68
69
70(deftest loop.5.20
71  (let ((x (vector 'a 'b 'c 'd)))
72    (loop for e across x collect e))
73  (a b c d))
74
75(deftest loop.5.21
76  (let ((x (vector 'a 'b 'c 'd)))
77    (loop for e across (the vector x) collect e))
78  (a b c d))
79
80(deftest loop.5.22
81  (let ((x (vector 'a 'b 'c 'd)))
82    (loop for e across (the simple-vector x) collect e))
83  (a b c d))
84
85(deftest loop.5.23
86  (let ((x (vector '(a) '(b) '(c) '(d))))
87    (loop for (e) across x collect e))
88  (a b c d))
89
90
91(deftest loop.5.30
92  (let ((x (make-array '(5) :initial-contents '(a b c d e)
93                  :adjustable t)))
94    (loop for e across x collect e))
95  (a b c d e))
96
97(deftest loop.5.32
98  (let* ((x (make-array '(5) :initial-contents '(a b c d e)))
99         (y (make-array '(3) :displaced-to x
100                   :displaced-index-offset 1)))
101    (loop for e across y collect e))
102  (b c d))
103
104;;; tests of 'as' form
105
106(deftest loop.5.33
107  (loop as e across "abc" collect e)
108  (#\a #\b #\c))
109
110(deftest loop.5.34
111  (loop as e of-type character across "abc" collect e)
112  (#\a #\b #\c))
113
114(deftest loop.5.35
115  (loop as e of-type integer across (the simple-vector (coerce '(1 2 3) 'simple-vector))
116        sum e)
117  6)
118
119;;; Loop across displaced vectors
120
121(deftest loop.5.36
122  (let* ((a (make-array '(10) :initial-contents '(a b c d e f g h i j)))
123         (da (make-array '(5) :displaced-to a
124                         :displaced-index-offset 2)))
125    (loop for e across da collect e))
126  (c d e f g))
127
128(deftest loop.5.37
129  (let* ((a (make-array '(10) :element-type 'base-char
130                        :initial-contents "abcdefghij"))
131         (da (make-array '(5) :element-type 'base-char
132                         :displaced-to a
133                         :displaced-index-offset 2)))
134    (loop for e across da collect e))
135  (#\c #\d #\e #\f #\g))
136
137(deftest loop.5.38
138  (let* ((a (make-array '(10) :element-type 'bit
139                        :initial-contents '(0 1 1 0 0 1 0 1 1 1)))
140         (da (make-array '(5) :element-type 'bit
141                         :displaced-to a
142                         :displaced-index-offset 2)))
143    (loop for e across da collect e))
144  (1 0 0 1 0))
145
146(deftest loop.5.39
147  (let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
148                       :fill-pointer 6)))
149    (loop for x across v collect x))
150  (1 2 3 4 5 6))
151
152(deftest loop.5.40
153  (loop for i from 1 to 40
154        for type = `(unsigned-byte ,i)
155        for v = (make-array '(10) :initial-contents '(0 0 1 1 0 1 1 1 0 0)
156                            :element-type type)
157        for r = (loop for x across v collect x)
158        unless (equal r '(0 0 1 1 0 1 1 1 0 0))
159        collect (list i r))
160  nil)
161
162(deftest loop.5.41
163  (loop for i from 1 to 40
164        for type = `(signed-byte ,i)
165        for v = (make-array '(10) :initial-contents '(0 0 -1 -1 0 -1 -1 -1 0 0)
166                            :element-type type)
167        for r = (loop for x across v collect x)
168        unless (equal r '(0 0 -1 -1 0 -1 -1 -1 0 0))
169        collect (list i r))
170  nil)
171
172(deftest loop.5.42
173  (let ((vals '(0 0 1 1 0 1 1 1 0 0)))
174    (loop for type in '(short-float single-float double-float long-float)
175          for fvals = (loop for v in vals collect (coerce v type))
176          for v = (make-array '(10) :initial-contents fvals :element-type type)
177          for r = (loop for x across v collect x)
178          unless (equal r fvals)
179          collect (list fvals r)))
180  nil)
181
182(deftest loop.5.43
183  (let ((vals '(0 0 1 1 0 1 1 1 0 0)))
184    (loop for etype in '(short-float single-float double-float long-float)
185          for type = `(complex ,etype)
186          for fvals = (loop for v in vals collect (coerce v type))
187          for v = (make-array '(10) :initial-contents fvals :element-type type)
188          for r = (loop for x across v collect x)
189          unless (equal r fvals)
190          collect (list fvals r)))
191  nil)
192
193;;; Test that explicit calls to macroexpand in subforms
194;;; are done in the correct environment
195
196(deftest loop.5.44
197  (macrolet
198   ((%m (z) z))
199   (loop for x across (expand-in-current-env (%m "148X")) collect x))
200  (#\1 #\4 #\8 #\X))
201
202(deftest loop.5.45
203  (macrolet
204   ((%m (z) z))
205   (loop as x across (expand-in-current-env (%m #*00110110)) collect x))
206  (0 0 1 1 0 1 1 0))
207
208;;; FIXME
209;;; Add tests for other specialized array types (integer types, floats, complex)
210
211;;; Error cases
212
213(deftest loop.5.error.1
214  (signals-error
215   (loop for (e . e) across (vector '(x . y) '(u . v)) collect e)
216   program-error)
217  t)
218
219(deftest loop.5.error.2
220  (signals-error
221   (loop for e across (vector '(x . y) '(u . v))
222         for e from 1 to 5 collect e)
223   program-error)
224  t)
225
226(deftest loop.5.error.3
227  (signals-error
228   (macroexpand
229    '(loop for (e . e) across (vector '(x . y) '(u . v)) collect e))
230   program-error)
231  t)
232
233(deftest loop.5.error.4
234  (signals-error
235   (macroexpand
236    '(loop for e across (vector '(x . y) '(u . v))
237           for e from 1 to 5 collect e))
238   program-error)
239  t)
Note: See TracBrowser for help on using the repository browser.