source: trunk/source/tests/ansi-tests/subtypep-array.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: 7.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Mar  1 16:23:57 2003
4;;;; Contains: Tests of SUBTYPEP on array types
5
6(in-package :cl-test)
7
8(compile-and-load "types-aux.lsp")
9
10;;; *array-element-types* is defined in ansi-aux.lsp
11
12(deftest subtypep.array.1
13  (let ((array-types (cons (find-class 'array)
14                           '(array (array) (array *) (array * *)))))
15    (loop for tp1 in array-types append
16          (loop for tp2 in array-types
17                unless (subtypep tp1 tp2)
18                collect (list tp1 tp2))))
19  nil)
20
21(deftest subtypep.array.2
22  (and (subtypep* '(array t) '(array t *))
23       (subtypep* '(array t *) '(array t))
24       t)
25  t)
26
27(deftest subtypep.array.3
28  (loop for i from 0 below (min 16 array-rank-limit)
29        for type = `(array * ,i)
30        for type2 = `(array * ,(make-list i :initial-element '*))
31        unless (and (subtypep type 'array)
32                    (subtypep type '(array))
33                    (subtypep type '(array *))
34                    (subtypep type '(array * *))
35                    (subtypep type type2))
36        collect type)
37  nil)
38
39(deftest subtypep.array.4
40  (loop for i from 0 below (min 16 array-rank-limit)
41        for type = `(array t ,i)
42        for type2 = `(array t ,(make-list i :initial-element '*))
43        unless (and (subtypep type '(array t))
44                    (subtypep type '(array t *))
45                    (subtypep type type2))
46        collect type)
47  nil)
48
49(deftest subtypep.array.5
50  (loop
51   for element-type in (cons '* *array-element-types*)
52   nconc
53   (loop for i from 0 below (min 16 array-rank-limit)
54         for type = `(array ,element-type ,i)
55         for type2 = `(array ,element-type ,(make-list i :initial-element '0))
56         for type3 = `(array ,element-type ,(make-list i :initial-element '1))
57         unless
58         (and (subtypep type2 type)
59              (subtypep type3 type)
60              (loop for j from 0 to i
61                    always
62                    (and
63                     (subtypep
64                      `(array ,element-type
65                              (,@(make-list j :initial-element '*)
66                                 ,@(make-list (- i j) :initial-element 2)))
67                      type)
68                     (subtypep
69                      `(array ,element-type
70                              (,@(make-list j :initial-element 2)
71                                 ,@(make-list (- i j) :initial-element '*)))
72                      type))))   
73         collect type))
74  nil)
75
76(deftest subtypep.array.6
77  (loop
78   for etype in (cons '* *array-element-types*)
79   append
80   (check-equivalence
81    `(and (array ,etype (* 10 * * *))
82          (array ,etype (* * * 29 *)))
83    `(array ,etype (* 10 * 29 *))))
84  nil)
85
86(deftest subtypep.array.7
87  (let ((etypes *array-element-types*))
88    (loop
89     for etp1 in etypes
90     for uaetp1 = (upgraded-array-element-type etp1)
91     append
92     (loop for etp2 in etypes
93           for uaetp2 = (upgraded-array-element-type etp2)
94           when (equal (multiple-value-list (subtypep* uaetp1 uaetp2))
95                       '(nil t))
96           append (check-disjointness `(array ,etp1) `(array ,etp2)))))
97  nil)
98
99(deftest subtypep.array.8
100  (let ((limit (min 16 array-rank-limit)))
101    (loop for i below limit
102          for type1 = `(array t ,i)
103          nconc
104          (loop for j below limit
105                for type2 = `(array t ,j)
106                when (and (/= i j)
107                          (subtypep type1 type2))
108                collect (list type1 type2))))
109  nil)
110
111(deftest subtypep.array.9
112  (let ((limit (min 16 array-rank-limit)))
113    (loop for i below limit
114          for type1 = `(array t ,(make-list i :initial-element 1))
115          nconc
116          (loop for j below limit
117                for type2 = `(array t ,(make-list j :initial-element 1))
118                when (and (/= i j)
119                          (subtypep type1 type2))
120                collect (list type1 type2))))
121  nil)
122
123(deftest subtypep.array.10
124  (subtypep* '(array t nil) 'integer)
125  nil t)
126
127(deftest subtypep.array.11
128  (subtypep* '(array t nil) '(array t (*)))
129  nil t)
130
131(deftest subtypep.array.12
132  (subtypep* '(array t nil) '(array t 1))
133  nil t)
134
135(deftest subtypep.array.13
136  (subtypep* '(array bit nil) '(array bit 1))
137  nil t)
138
139;;;; Tests on the definitions of various vector types
140
141(deftest string-is-not-vector-of-character.1
142  :notes (:nil-vectors-are-strings)
143  (subtypep* 'string '(vector character))
144  nil t)
145
146(deftest vector-of-character-is-string.2
147  (subtypep* '(vector character) 'string)
148  t t)
149
150(deftest string-is-not-vector-of-character.3
151  :notes (:nil-vectors-are-strings)
152  (subtypep* '(string *) '(vector character))
153  nil t)
154
155(deftest vector-of-character-is-string.4
156  (subtypep* '(vector character) '(string *))
157  t t)
158
159(deftest string-is-not-vector-of-character.5
160  :notes (:nil-vectors-are-strings)
161  (subtypep* '(string 17) '(vector character 17))
162  nil t)
163
164(deftest vector-of-character-is-string.6
165  (subtypep* '(vector character 17) '(string 17))
166  t t)
167
168(deftest base-string-is-vector-of-base-char.1
169  (subtypep* 'base-string '(vector base-char))
170  t t)
171
172(deftest base-string-is-vector-of-base-char.2
173  (subtypep* '(vector base-char) 'base-string)
174  t t)
175
176(deftest base-string-is-vector-of-base-char.3
177  (subtypep* '(base-string *) '(vector base-char))
178  t t)
179
180(deftest base-string-is-vector-of-base-char.4
181  (subtypep* '(vector base-char) '(base-string *))
182  t t)
183
184(deftest base-string-is-vector-of-base-char.5
185  (subtypep* '(base-string 17) '(vector base-char 17))
186  t t)
187
188(deftest base-string-is-vector-of-base-char.6
189  (subtypep* '(vector base-char 17) '(base-string 17))
190  t t)
191
192(deftest simple-base-string-is-simple-1d-array-of-base-char.1
193  (subtypep* 'simple-base-string '(simple-array base-char (*)))
194  t t)
195
196(deftest simple-base-string-is-simple-1d-array-of-base-char.2
197  (subtypep* '(simple-array base-char (*)) 'simple-base-string)
198  t t)
199
200(deftest simple-base-string-is-simple-1d-array-of-base-char.3
201  (subtypep* '(simple-base-string *) '(simple-array base-char (*)))
202  t t)
203
204(deftest simple-base-string-is-simple-1d-array-of-base-char.4
205  (subtypep* '(simple-array base-char (*)) '(simple-base-string *))
206  t t)
207
208(deftest simple-base-string-is-simple-1d-array-of-base-char.5
209  (subtypep* '(simple-base-string 17) '(simple-array base-char (17)))
210  t t)
211
212(deftest simple-base-string-is-simple-1d-array-of-base-char.6
213  (subtypep* '(simple-array base-char (17)) '(simple-base-string 17))
214  t t)
215
216(deftest simple-string-is-not-simple-1d-array-of-character.1
217  :notes (:nil-vectors-are-strings)
218  (subtypep* 'simple-string '(simple-array character (*)))
219  nil t)
220
221(deftest simple-1d-array-of-character-is-simple-string.2
222  (subtypep* '(simple-array character (*)) 'simple-string)
223  t t)
224
225(deftest simple-string-is-not-simple-1d-array-of-character.3
226  :notes (:nil-vectors-are-strings)
227  (subtypep* '(simple-string *) '(simple-array character (*)))
228  nil t)
229
230(deftest simple-1d-array-of-character-is-simple-string.4
231  (subtypep* '(simple-array character (*)) '(simple-string *))
232  t t)
233
234(deftest simple-string-is-not-simple-1d-array-of-character.5
235  :notes (:nil-vectors-are-strings)
236  (subtypep* '(simple-string 17) '(simple-array character (17)))
237  nil t)
238
239(deftest simple-1d-array-of-character-is-simple-string.6
240  (subtypep* '(simple-array character (17)) '(simple-string 17))
241  t t)
242
243(deftest vector-is-1d-array.1
244  (subtypep* 'vector '(array * (*)))
245  t t)
246
247(deftest vector-is-1d-array.2
248  (subtypep* '(array * (*)) 'vector)
249  t t)
250
251(deftest vector-is-1d-array.3
252  (subtypep* '(vector *) '(array * (*)))
253  t t)
254
255(deftest vector-is-1d-array.4
256  (subtypep* '(array * (*)) '(vector *))
257  t t)
258
259(deftest vector-is-1d-array.5
260  (subtypep* '(vector * 17) '(array * (17)))
261  t t)
262
263(deftest vector-is-1d-array.6
264  (subtypep* '(array * (17)) '(vector * 17))
265  t t)
266
267(deftest simple-vector-is-simple-1d-array.1
268  (subtypep* 'simple-vector '(simple-array t (*)))
269  t t)
270
271(deftest simple-vector-is-simple-1d-array.2
272  (subtypep* '(simple-array t (*)) 'simple-vector)
273  t t)
274
275(deftest simple-vector-is-simple-1d-array.3
276  (subtypep* '(simple-vector *) '(simple-array t (*)))
277  t t)
278
279(deftest simple-vector-is-simple-1d-array.4
280  (subtypep* '(simple-array t (*)) '(simple-vector *))
281  t t)
282
283(deftest simple-vector-is-simple-1d-array.5
284  (subtypep* '(simple-vector 17) '(simple-array t (17)))
285  t t)
286
287(deftest simple-vector-is-simple-1d-array.6
288  (subtypep* '(simple-array t (17)) '(simple-vector 17))
289  t t)
Note: See TracBrowser for help on using the repository browser.