/[gcl]/gcl/ansi-tests/elt.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/elt.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by pfdietz, Mon Feb 10 03:09:37 2003 UTC revision 1.11 by pfdietz, Mon Feb 17 04:22:04 2003 UTC
# Line 9  Line 9 
9    
10  ;; elt on lists  ;; elt on lists
11    
12  (deftest elt-1  (deftest elt.1
13    (classify-error (elt nil 0))    (classify-error (elt nil 0))
14    type-error)    type-error)
15    
16  (deftest elt-1a  (deftest elt.1a
17    (classify-error (elt nil -10))    (classify-error (elt nil -10))
18    type-error)    type-error)
19    
20  (deftest elt-1b  (deftest elt.1b
21    (classify-error (locally (elt nil 0) t))    (classify-error (locally (elt nil 0) t))
22    type-error)    type-error)
23    
24  (deftest elt-2  (deftest elt.2
25    (classify-error (elt nil 1000000))    (classify-error (elt nil 1000000))
26    type-error)    type-error)
27    
28  (deftest elt-3 (elt '(a b c d e) 0) a)  (deftest elt.3 (elt '(a b c d e) 0) a)
29  (deftest elt-4 (elt '(a b c d e) 2) c)  (deftest elt.4 (elt '(a b c d e) 2) c)
30  (deftest elt-5 (elt '(a b c d e) 4) e)  (deftest elt.5 (elt '(a b c d e) 4) e)
31  (deftest elt-5a  (deftest elt.5a
32    (classify-error (elt '(a b c d e) -4))    (classify-error (elt '(a b c d e) -4))
33    type-error)    type-error)
34    
35  (deftest elt-6  (deftest elt.6
36    (let ((x (make-int-list 1000)))    (let ((x (make-int-list 1000)))
37      (notnot-mv      (notnot-mv
38       (every       (every
# Line 40  Line 40 
40        x)))        x)))
41    t)    t)
42    
43  (deftest elt-7  (deftest elt.7
44    (let* ((x (list 'a 'b 'c 'd))    (let* ((x (list 'a 'b 'c 'd))
45           (y (setf (elt x 0) 'e)))           (y (setf (elt x 0) 'e)))
46      (list x y))      (list x y))
47    ((e b c d) e))    ((e b c d) e))
48    
49  (deftest elt-8  (deftest elt.8
50    (let* ((x (list 'a 'b 'c 'd))    (let* ((x (list 'a 'b 'c 'd))
51           (y (setf (elt x 1) 'e)))           (y (setf (elt x 1) 'e)))
52      (list x y))      (list x y))
53    ((a e c d) e))    ((a e c d) e))
54    
55  (deftest elt-9  (deftest elt.9
56    (let* ((x (list 'a 'b 'c 'd))    (let* ((x (list 'a 'b 'c 'd))
57           (y (setf (elt x 3) 'e)))           (y (setf (elt x 3) 'e)))
58      (list x y))      (list x y))
59    ((a b c e) e))    ((a b c e) e))
60    
61  (deftest elt-10  (deftest elt.10
62    (classify-error    (classify-error
63     (let ((x (list 'a 'b 'c)))     (let ((x (list 'a 'b 'c)))
64       (setf (elt x 4) 'd)))       (setf (elt x 4) 'd)))
65    type-error)    type-error)
66    
67  (deftest elt-11  (deftest elt.11
68    (let ((x (list 'a 'b 'c 'd 'e)))    (let ((x (list 'a 'b 'c 'd 'e)))
69      (let ((y (loop for c on x collect c)))      (let ((y (loop for c on x collect c)))
70        (setf (elt x 2) 'f)        (setf (elt x 2) 'f)
# Line 74  Line 74 
74                (loop for c on x collect c)))))                (loop for c on x collect c)))))
75    t)    t)
76    
77  (deftest elt-12  (deftest elt.12
78    (let ((x (make-int-list 100000)))    (let ((x (make-int-list 100000)))
79      (elt x 90000))      (elt x 90000))
80    90000)    90000)
81    
82  (deftest elt-13  (deftest elt.13
83    (let ((x (make-int-list 100000)))    (let ((x (make-int-list 100000)))
84      (setf (elt x 80000) 'foo)      (setf (elt x 80000) 'foo)
85      (list (elt x 79999)      (list (elt x 79999)
# Line 87  Line 87 
87            (elt x 80001)))            (elt x 80001)))
88    (79999 foo 80001))    (79999 foo 80001))
89    
90  (deftest elt-14  (deftest elt.14
91    (classify-error    (classify-error
92     (let ((x (list 'a 'b 'c)))     (let ((x (list 'a 'b 'c)))
93       (elt x 10)))       (elt x 10)))
94    type-error)    type-error)
95    
96  (deftest elt-15  (deftest elt.15
97    (classify-error    (classify-error
98     (let ((x (list 'a 'b 'c)))     (let ((x (list 'a 'b 'c)))
99       (elt x 'a)))       (elt x 'a)))
100    type-error)    type-error)
101    
102  (deftest elt-16  (deftest elt.16
103    (classify-error    (classify-error
104     (let ((x (list 'a 'b 'c)))     (let ((x (list 'a 'b 'c)))
105       (elt x 10.0)))       (elt x 10.0)))
106    type-error)    type-error)
107    
108  (deftest elt-17  (deftest elt.17
109    (classify-error    (classify-error
110     (let ((x (list 'a 'b 'c)))     (let ((x (list 'a 'b 'c)))
111       (elt x -1)))       (elt x -1)))
112    type-error)    type-error)
113    
114  (deftest elt-18  (deftest elt.18
115    (classify-error    (classify-error
116     (let ((x (list 'a 'b 'c)))     (let ((x (list 'a 'b 'c)))
117       (elt x -100000000000000000)))       (elt x -100000000000000000)))
118    type-error)    type-error)
119    
120  (deftest elt-19  (deftest elt.19
121    (classify-error    (classify-error
122     (let ((x (list 'a 'b 'c)))     (let ((x (list 'a 'b 'c)))
123       (elt x #\w)))       (elt x #\w)))
124    type-error)    type-error)
125    
126  (deftest elt.20  (deftest elt.order.1
127    (let ((i 0) x y)    (let ((i 0) x y)
128      (values      (values
129       (elt (progn (setf x (incf i)) '(a b c d e))       (elt (progn (setf x (incf i)) '(a b c d e))
# Line 131  Line 131 
131       i x y))       i x y))
132    d 2 1 2)    d 2 1 2)
133    
134  (deftest elt.21  (deftest elt.order.2
135    (let ((i 0) x y z)    (let ((i 0) x y z)
136      (let ((a (make-array 1 :initial-element (list 'a 'b 'c 'd 'e))))      (let ((a (make-array 1 :initial-element (list 'a 'b 'c 'd 'e))))
137        (values        (values
# Line 142  Line 142 
142         i x y z)))         i x y z)))
143    k (a b c k e) 3 1 2 3)    k (a b c k e) 3 1 2 3)
144    
145  (deftest elt-v-1  (deftest elt-v.1
146    (classify-error    (classify-error
147     (elt (make-array '(0)) 0))     (elt (make-array '(0)) 0))
148    type-error)    type-error)
149    
150  ;; (deftest elt-v-2 (elt (make-array '(1)) 0) nil)  ;; actually undefined  ;; (deftest elt-v.2 (elt (make-array '(1)) 0) nil)  ;; actually undefined
151  (deftest elt-v-3  (deftest elt-v.3
152    (elt (make-array '(5) :initial-contents '(a b c d e)) 0)    (elt (make-array '(5) :initial-contents '(a b c d e)) 0)
153    a)    a)
154    
155  (deftest elt-v-4  (deftest elt-v.4
156    (elt (make-array '(5) :initial-contents '(a b c d e)) 2)    (elt (make-array '(5) :initial-contents '(a b c d e)) 2)
157    c)    c)
158    
159  (deftest elt-v-5  (deftest elt-v.5
160    (elt (make-array '(5) :initial-contents '(a b c d e)) 4)    (elt (make-array '(5) :initial-contents '(a b c d e)) 4)
161    e)    e)
162    
163  (deftest elt-v-6  (deftest elt-v.6
164      (elt-v-6-body)      (elt-v-6-body)
165    t)    t)
166    
167  (deftest elt-v-7  (deftest elt-v.7
168    (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd)))    (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd)))
169           (y (setf (elt x 0) 'e)))           (y (setf (elt x 0) 'e)))
170      (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))      (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
171    (e b c d e))    (e b c d e))
172    
173  (deftest elt-v-8  (deftest elt-v.8
174    (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd)))    (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd)))
175           (y (setf (elt x 1) 'e)))           (y (setf (elt x 1) 'e)))
176      (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))      (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
177    (a e c d e))    (a e c d e))
178    
179  (deftest elt-v-9  (deftest elt-v.9
180    (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd)))    (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd)))
181           (y (setf (elt x 3) 'e)))           (y (setf (elt x 3) 'e)))
182      (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))      (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
183    (a b c e e))    (a b c e e))
184    
185  (deftest elt-v-10  (deftest elt-v.10
186    (classify-error    (classify-error
187     (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c))))     (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c))))
188       (setf (elt x 4) 'd)))       (setf (elt x 4) 'd)))
189    type-error)    type-error)
190    
191  (deftest elt-v-11  (deftest elt-v.11
192    (classify-error    (classify-error
193     (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c))))     (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c))))
194       (setf (elt x -100) 'd)))       (setf (elt x -100) 'd)))
195    type-error)    type-error)
196    
197  (deftest elt-v-12  (deftest elt-v.12
198      (let ((x (make-int-array 100000)))      (let ((x (make-int-array 100000)))
199        (elt x 90000))        (elt x 90000))
200    90000)    90000)
201    
202  (deftest elt-v-13  (deftest elt-v.13
203    (let ((x (make-int-array 100000)))    (let ((x (make-int-array 100000)))
204      (setf (elt x 80000) 'foo)      (setf (elt x 80000) 'foo)
205      (list (elt x 79999)      (list (elt x 79999)
# Line 209  Line 209 
209    
210  ;;;  Adjustable arrays  ;;;  Adjustable arrays
211    
212  (deftest elt-adj-array-1  (deftest elt-adj-array.1
213    (classify-error (elt (make-adj-array '(0)) 0))    (classify-error (elt (make-adj-array '(0)) 0))
214    type-error)    type-error)
215    
216  ;;; (deftest elt-adj-array-2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined  ;;; (deftest elt-adj-array.2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined
217    
218  (deftest elt-adj-array-3  (deftest elt-adj-array.3
219   (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 0)   (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 0)
220    a)    a)
221    
222  (deftest elt-adj-array-4  (deftest elt-adj-array.4
223   (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 2)   (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 2)
224    c)    c)
225    
226  (deftest elt-adj-array-5  (deftest elt-adj-array.5
227   (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 4)   (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 4)
228    e)    e)
229    
230  (deftest elt-adj-array-6  (deftest elt-adj-array.6
231      (elt-adj-array-6-body)      (elt-adj-array-6-body)
232    t)    t)
233    
234  (deftest elt-adj-array-7  (deftest elt-adj-array.7
235    (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd)))    (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd)))
236           (y (setf (elt x 0) 'e)))           (y (setf (elt x 0) 'e)))
237      (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))      (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
238    (e b c d e))    (e b c d e))
239    
240  (deftest elt-adj-array-8  (deftest elt-adj-array.8
241    (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd)))    (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd)))
242           (y (setf (elt x 1) 'e)))           (y (setf (elt x 1) 'e)))
243      (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))      (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
244    (a e c d e))    (a e c d e))
245    
246  (deftest elt-adj-array-9  (deftest elt-adj-array.9
247    (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd)))    (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd)))
248           (y (setf (elt x 3) 'e)))           (y (setf (elt x 3) 'e)))
249      (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))      (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
250    (a b c e e))    (a b c e e))
251    
252  (deftest elt-adj-array-10  (deftest elt-adj-array.10
253    (classify-error    (classify-error
254     (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c))))     (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c))))
255       (setf (elt x 4) 'd)))       (setf (elt x 4) 'd)))
256    type-error)    type-error)
257    
258  (deftest elt-adj-array-11  (deftest elt-adj-array.11
259    (classify-error    (classify-error
260     (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c))))     (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c))))
261       (setf (elt x -100) 'd)))       (setf (elt x -100) 'd)))
262    type-error)    type-error)
263    
264  (deftest elt-adj-array-12  (deftest elt-adj-array.12
265      (let ((x (make-int-array 100000 #'make-adj-array)))      (let ((x (make-int-array 100000 #'make-adj-array)))
266        (elt x 90000))        (elt x 90000))
267    90000)    90000)
268    
269  (deftest elt-adj-array-13  (deftest elt-adj-array.13
270      (let ((x (make-int-array 100000 #'make-adj-array)))      (let ((x (make-int-array 100000 #'make-adj-array)))
271      (setf (elt x 80000) 'foo)      (setf (elt x 80000) 'foo)
272      (list (elt x 79999)      (list (elt x 79999)
# Line 276  Line 276 
276    
277  ;; displaced arrays  ;; displaced arrays
278    
279  (deftest elt-displaced-array-1  (deftest elt-displaced-array.1
280    (classify-error (elt (make-displaced-array '(0) 100) 0))    (classify-error (elt (make-displaced-array '(0) 100) 0))
281    type-error)    type-error)
282    
283  (deftest elt-displaced-array-2  (deftest elt-displaced-array.2
284    (elt (make-displaced-array '(1) 100) 0)    (elt (make-displaced-array '(1) 100) 0)
285    100)    100)
286    
287  (deftest elt-displaced-array-3  (deftest elt-displaced-array.3
288    (elt (make-displaced-array '(5) 100) 4)    (elt (make-displaced-array '(5) 100) 4)
289    104)    104)
290    
291  ;;; Arrays with fill points  ;;; Arrays with fill points
292    
293  (deftest elt-fill-pointer-1  (deftest elt-fill-pointer.1
294    (let ((a (make-array '(5) :initial-contents '(a b c d e)    (let ((a (make-array '(5) :initial-contents '(a b c d e)
295                         :fill-pointer 3)))                         :fill-pointer 3)))
296      (values (elt a 0) (elt a 1) (elt a 2)))      (values (elt a 0) (elt a 1) (elt a 2)))
297    a b c)    a b c)
298    
299  (deftest elt-fill-pointer-2  (deftest elt-fill-pointer.2
300    (let ((a (make-array '(5)    (let ((a (make-array '(5)
301                         :initial-contents '(0 0 1 0 0)                         :initial-contents '(0 0 1 0 0)
302                         :element-type 'bit                         :element-type 'bit
# Line 304  Line 304 
304      (values (elt a 0) (elt a 1) (elt a 2)))      (values (elt a 0) (elt a 1) (elt a 2)))
305    0 0 1)    0 0 1)
306    
307  (deftest elt-fill-pointer-3  (deftest elt-fill-pointer.3
308    (classify-error    (classify-error
309     (let ((a (make-array '(5)     (let ((a (make-array '(5)
310                          :initial-contents '(0 0 1 0 0)                          :initial-contents '(0 0 1 0 0)
# Line 312  Line 312 
312       (elt a 4)))       (elt a 4)))
313    type-error)    type-error)
314    
315  (deftest elt-fill-pointer-4  (deftest elt-fill-pointer.4
316    (classify-error    (classify-error
317     (let ((a (make-array '(5)     (let ((a (make-array '(5)
318                          :initial-contents '(0 0 1 0 0)                          :initial-contents '(0 0 1 0 0)
# Line 321  Line 321 
321       (elt a 4)))       (elt a 4)))
322    type-error)    type-error)
323    
324  (deftest elt-fill-pointer-5  (deftest elt-fill-pointer.5
325     (let ((a (make-array '(5)     (let ((a (make-array '(5)
326                          :initial-contents '(#\a #\b #\c #\d #\e)                          :initial-contents '(#\a #\b #\c #\d #\e)
327                          :element-type 'character                          :element-type 'character
# Line 329  Line 329 
329       (values (elt a 0) (elt a 1) (elt a 2)))       (values (elt a 0) (elt a 1) (elt a 2)))
330     #\a #\b #\c)     #\a #\b #\c)
331    
332  (deftest elt-fill-pointer-6  (deftest elt-fill-pointer.6
333    (classify-error    (classify-error
334     (let ((a (make-array '(5)     (let ((a (make-array '(5)
335                          :initial-contents '(#\a #\b #\c #\d #\e)                          :initial-contents '(#\a #\b #\c #\d #\e)
# Line 338  Line 338 
338       (elt a 4)))       (elt a 4)))
339    type-error)    type-error)
340    
341  (deftest elt-fill-pointer-7  (deftest elt-fill-pointer.7
342     (let ((a (make-array '(5)     (let ((a (make-array '(5)
343                          :initial-contents '(#\a #\b #\c #\d #\e)                          :initial-contents '(#\a #\b #\c #\d #\e)
344                          :element-type 'base-char                          :element-type 'base-char
# Line 346  Line 346 
346       (values (elt a 0) (elt a 1) (elt a 2)))       (values (elt a 0) (elt a 1) (elt a 2)))
347     #\a #\b #\c)     #\a #\b #\c)
348    
349  (deftest elt-fill-pointer-8  (deftest elt-fill-pointer.8
350    (classify-error    (classify-error
351     (let ((a (make-array '(5)     (let ((a (make-array '(5)
352                          :initial-contents '(#\a #\b #\c #\d #\e)                          :initial-contents '(#\a #\b #\c #\d #\e)

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26