source: trunk/source/tests/ansi-tests/subtypep-float.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: 11.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Feb 15 11:55:37 2003
4;;;; Contains: Tests for subtype relationships on float types
5
6(in-package :cl-test)
7
8(compile-and-load "types-aux.lsp")
9
10;;;;;;;
11
12(deftest subtypep.float.1
13  (loop for tp in +float-types+
14        append (check-subtypep tp 'float t t))
15  nil)
16
17(deftest subtypep.float.2
18  (if (subtypep 'short-float 'long-float)
19      (loop for tp in +float-types+
20            append
21            (loop for tp2 in +float-types+
22                  append (check-subtypep tp tp2 t t)))
23    nil)
24  nil)
25
26(deftest subtypep.float.3
27  (if (and (not (subtypep 'short-float 'single-float))
28           (subtypep 'single-float 'long-float))
29      (append
30       (check-equivalence 'single-float 'double-float)
31       (check-equivalence 'single-float 'long-float)
32       (check-equivalence 'double-float 'long-float)
33       (classes-are-disjoint 'short-float 'single-float)
34       (classes-are-disjoint 'short-float 'double-float)
35       (classes-are-disjoint 'short-float 'long-float))
36    nil)
37  nil)
38
39(deftest subtypep.float.4
40  (if (and (subtypep 'single-float 'short-float)
41           (subtypep 'double-float 'long-float)
42           (not (subtypep 'short-float 'double-float)))
43      (append
44       (check-equivalence 'short-float 'single-float)
45       (check-equivalence 'double-float 'long-float)
46       (loop for tp in '(short-float single-float)
47             append
48             (loop for tp2 in '(double-float long-float)
49                   append (classes-are-disjoint tp tp2))))
50    nil)
51  nil)
52
53(deftest subtypep.float.5
54  (if (and (not (subtypep 'single-float 'short-float))
55           (not (subtypep 'single-float 'double-float))
56           (subtypep 'double-float 'long-float))
57      (append
58       (classes-are-disjoint 'short-float 'single-float)
59       (classes-are-disjoint 'short-float 'double-float)
60       (classes-are-disjoint 'short-float 'long-float)
61       (classes-are-disjoint 'single-float 'double-float)
62       (classes-are-disjoint 'single-float 'long-float)
63       (check-equivalence 'double-float 'long-float))
64    nil)
65  nil)
66
67(deftest subtypep.float.6
68  (if (and (subtypep 'single-float 'short-float)
69           (not (subtypep 'single-float 'double-float))
70           (not (subtypep 'double-float 'long-float)))
71      (append
72       (check-equivalence 'short-float 'single-float)
73       (classes-are-disjoint 'single-float 'double-float)
74       (classes-are-disjoint 'single-float 'long-float)
75       (classes-are-disjoint 'double-float 'long-float))
76    nil)
77  nil)
78
79(deftest subtypep.float.7
80  (if (and (not (subtypep 'single-float 'short-float))
81           (not (subtypep 'single-float 'double-float))
82           (not (subtypep 'double-float 'long-float)))
83      (loop for tp in +float-types+
84            append
85            (loop for tp2 in +float-types+
86                  unless (eq tp tp2)
87                  append (classes-are-disjoint tp tp2)))
88    nil)
89  nil)
90
91(deftest subtypep.float.8
92  (subtypep* '(short-float 0.0s0 10.0s0) '(short-float 0.0s0 11.0s0))
93  t t)
94
95(deftest subtypep.float.9
96  (subtypep* '(single-float 0.0f0 10.0f0) '(single-float 0.0f0 11.0f0))
97  t t)
98
99(deftest subtypep.float.10
100  (subtypep* '(double-float 0.0d0 10.0d0) '(double-float 0.0d0 11.0d0))
101  t t)
102
103(deftest subtypep.float.11
104  (subtypep* '(long-float 0.0l0 10.0l0) '(long-float 0.0l0 11.0l0))
105  t t)
106
107(deftest subtypep.float.12
108  (subtypep* '(short-float 0.0s0 11.0s0) '(short-float 0.0s0 10.0s0))
109  nil t)
110
111(deftest subtypep.float.13
112  (subtypep* '(single-float 0.0f0 11.0f0) '(single-float 0.0f0 10.0f0))
113  nil t)
114
115(deftest subtypep.float.14
116  (subtypep* '(double-float 0.0d0 11.0d0) '(double-float 0.0d0 10.0d0))
117  nil t)
118
119(deftest subtypep.float.15
120  (subtypep* '(long-float 0.0l0 11.0l0) '(long-float 0.0l0 10.0l0))
121  nil t)
122
123(deftest subtypep.float.16
124  (subtypep* '(short-float 0.0s0 (10.0s0)) '(short-float 0.0s0 10.0s0))
125  t t)
126
127(deftest subtypep.float.17
128  (subtypep* '(single-float 0.0f0 (10.0f0)) '(single-float 0.0f0 10.0f0))
129  t t)
130
131(deftest subtypep.float.18
132  (subtypep* '(double-float 0.0d0 (10.0d0)) '(double-float 0.0d0 10.0d0))
133  t t)
134
135(deftest subtypep.float.19
136  (subtypep* '(long-float 0.0l0 (10.0l0)) '(long-float 0.0l0 10.0l0))
137  t t)
138
139(deftest subtypep.float.20
140  (subtypep* '(short-float 0.0s0 10.0s0) '(short-float 0.0s0 (10.0s0)))
141  nil t)
142
143(deftest subtypep.float.21
144  (subtypep* '(single-float 0.0f0 10.0f0) '(single-float 0.0f0 (10.0f0)))
145  nil t)
146
147(deftest subtypep.float.22
148  (subtypep* '(double-float 0.0d0 10.0d0) '(double-float 0.0d0 (10.0d0)))
149  nil t)
150
151(deftest subtypep.float.23
152  (subtypep* '(long-float 0.0l0 10.0l0) '(long-float 0.0l0 (10.0l0)))
153  nil t)
154
155(deftest subtypep.float.24
156  (check-equivalence '(and (short-float 0.0s0 2.0s0)
157                           (short-float 1.0s0 3.0s0))
158                     '(short-float 1.0s0 2.0s0))
159  nil)
160
161(deftest subtypep.float.25
162  (check-equivalence '(and (single-float 0.0f0 2.0f0)
163                           (single-float 1.0f0 3.0f0))
164                     '(single-float 1.0f0 2.0f0))
165  nil)
166
167(deftest subtypep.float.26
168  (check-equivalence '(and (double-float 0.0d0 2.0d0)
169                           (double-float 1.0d0 3.0d0))
170                     '(double-float 1.0d0 2.0d0))
171  nil)
172
173(deftest subtypep.float.27
174  (check-equivalence '(and (long-float 0.0l0 2.0l0)
175                           (long-float 1.0l0 3.0l0))
176                     '(long-float 1.0l0 2.0l0))
177  nil)
178
179;;; Signed zero tests
180
181(deftest subtypep.short-float.zero.1
182  (check-equivalence '(short-float 0.0s0 *)
183                     '(or (short-float (0.0s0) *)
184                          (member -0.0s0 0.0s0)))
185  nil)
186
187(unless (eql 0.0s0 -0.0s0)
188  (deftest subtypep.short-float.zero.2a
189    (values (subtypep '(short-float 0.0s0)
190                      '(or (short-float (0.0s0)) (member 0.0s0))))
191    nil)
192  (deftest subtypep.short-float.zero.2b
193    (values (subtypep '(short-float 0.0s0)
194                      '(or (short-float (0.0s0)) (member -0.0s0))))
195    nil))
196
197(deftest subtypep.short-float.zero.3
198  (subtypep* '(short-float -0.0s0 *) '(short-float 0.0s0 *))
199  t t)
200
201(deftest subtypep.short-float.zero.4
202  (subtypep* '(short-float * -0.0s0) '(short-float * 0.0s0))
203  t t)
204
205(deftest subtypep.short-float.zero.5
206  (subtypep* '(short-float (-0.0s0) *) '(short-float (0.0s0) *))
207  t t)
208
209(deftest subtypep.short-float.zero.6
210  (subtypep* '(short-float * (-0.0s0)) '(short-float * (0.0s0)))
211  t t)
212
213(deftest subtypep.short-float.zero.7
214  (subtypep* '(short-float 0.0s0 *) '(short-float -0.0s0 *))
215  t t)
216
217(deftest subtypep.short-float.zero.8
218  (subtypep* '(short-float * 0.0s0) '(short-float * -0.0s0))
219  t t)
220
221(deftest subtypep.short-float.zero.9
222  (subtypep* '(short-float (0.0s0) *) '(short-float (-0.0s0) *))
223  t t)
224
225(deftest subtypep.short-float.zero.10
226  (subtypep* '(short-float * (0.0s0)) '(short-float * (-0.0s0)))
227  t t)
228
229;;;
230
231(deftest subtypep.float.zero.3
232  (subtypep* '(float -0.0 *) '(float 0.0 *))
233  t t)
234
235(deftest subtypep.float.zero.4
236  (subtypep* '(float * -0.0) '(float * 0.0))
237  t t)
238
239(deftest subtypep.float.zero.5
240  (subtypep* '(float (-0.0) *) '(float (0.0) *))
241  t t)
242
243(deftest subtypep.float.zero.6
244  (subtypep* '(float * (-0.0)) '(float * (0.0)))
245  t t)
246
247(deftest subtypep.float.zero.7
248  (subtypep* '(float 0.0 *) '(float -0.0 *))
249  t t)
250
251(deftest subtypep.float.zero.8
252  (subtypep* '(float * 0.0) '(float * -0.0))
253  t t)
254
255(deftest subtypep.float.zero.9
256  (subtypep* '(float (0.0) *) '(float (-0.0) *))
257  t t)
258
259(deftest subtypep.float.zero.10
260  (subtypep* '(float * (0.0)) '(float * (-0.0)))
261  t t)
262
263;;;
264
265(deftest subtypep.single-float.zero.1
266  (check-equivalence '(single-float 0.0f0 *)
267                     '(or (single-float (0.0f0) *)
268                          (member -0.0f0 0.0f0)))
269  nil)
270
271(unless (eql 0.0f0 -0.0f0)
272  (deftest subtypep.single-float.zero.2a
273    (values (subtypep '(single-float 0.0f0)
274                      '(or (single-float (0.0f0)) (member 0.0f0))))
275    nil)
276  (deftest subtypep.single-float.zero.2b
277    (values (subtypep '(single-float 0.0f0)
278                      '(or (single-float (0.0f0)) (member -0.0f0))))
279    nil))
280
281(deftest subtypep.single-float.zero.3
282  (subtypep* '(single-float -0.0f0 *) '(single-float 0.0f0 *))
283  t t)
284
285(deftest subtypep.single-float.zero.4
286  (subtypep* '(single-float * -0.0f0) '(single-float * 0.0f0))
287  t t)
288
289(deftest subtypep.single-float.zero.5
290  (subtypep* '(single-float (-0.0f0) *) '(single-float (0.0f0) *))
291  t t)
292
293(deftest subtypep.single-float.zero.6
294  (subtypep* '(single-float * (-0.0f0)) '(single-float * (0.0f0)))
295  t t)
296
297(deftest subtypep.single-float.zero.7
298  (subtypep* '(single-float 0.0f0 *) '(single-float -0.0f0 *))
299  t t)
300
301(deftest subtypep.single-float.zero.8
302  (subtypep* '(single-float * 0.0f0) '(single-float * -0.0f0))
303  t t)
304
305(deftest subtypep.single-float.zero.9
306  (subtypep* '(single-float (0.0f0) *) '(single-float (-0.0f0) *))
307  t t)
308
309(deftest subtypep.single-float.zero.10
310  (subtypep* '(single-float * (0.0f0)) '(single-float * (-0.0f0)))
311  t t)
312
313;;;
314
315(deftest subtypep.long-float.zero.1
316  (check-equivalence '(long-float 0.0l0 *)
317                     '(or (long-float (0.0l0) *)
318                          (member -0.0l0 0.0l0)))
319  nil)
320
321(unless (eql 0.0l0 -0.0l0)
322  (deftest subtypep.long-float.zero.2a
323    (values (subtypep '(long-float 0.0l0)
324                      '(or (long-float (0.0l0)) (member 0.0l0))))
325    nil)
326  (deftest subtypep.long-float.zero.2b
327    (values (subtypep '(long-float 0.0l0)
328                      '(or (long-float (0.0l0)) (member -0.0l0))))
329    nil))
330
331(deftest subtypep.long-float.zero.3
332  (subtypep* '(long-float -0.0l0 *) '(long-float 0.0l0 *))
333  t t)
334
335(deftest subtypep.long-float.zero.4
336  (subtypep* '(long-float * -0.0l0) '(long-float * 0.0l0))
337  t t)
338
339(deftest subtypep.long-float.zero.5
340  (subtypep* '(long-float (-0.0l0) *) '(long-float (0.0l0) *))
341  t t)
342
343(deftest subtypep.long-float.zero.6
344  (subtypep* '(long-float * (-0.0l0)) '(long-float * (0.0l0)))
345  t t)
346
347(deftest subtypep.long-float.zero.7
348  (subtypep* '(long-float 0.0l0 *) '(long-float -0.0l0 *))
349  t t)
350
351(deftest subtypep.long-float.zero.8
352  (subtypep* '(long-float * 0.0l0) '(long-float * -0.0l0))
353  t t)
354
355(deftest subtypep.long-float.zero.9
356  (subtypep* '(long-float (0.0l0) *) '(long-float (-0.0l0) *))
357  t t)
358
359(deftest subtypep.long-float.zero.10
360  (subtypep* '(long-float * (0.0l0)) '(long-float * (-0.0l0)))
361  t t)
362
363;;;
364
365(deftest subtypep.double-float.zero.1
366  (check-equivalence '(double-float 0.0d0 *)
367                     '(or (double-float (0.0d0) *)
368                          (member -0.0d0 0.0d0)))
369  nil)
370
371(unless (eql 0.0d0 -0.0d0)
372  (deftest subtypep.double-float.zero.2a
373    (values (subtypep '(double-float 0.0d0)
374                      '(or (double-float (0.0d0)) (member 0.0d0))))
375    nil)
376  (deftest subtypep.double-float.zero.2b
377    (values (subtypep '(double-float 0.0d0)
378                      '(or (double-float (0.0d0)) (member -0.0d0))))
379    nil))
380
381(deftest subtypep.double-float.zero.3
382  (subtypep* '(double-float -0.0d0 *) '(double-float 0.0d0 *))
383  t t)
384
385(deftest subtypep.double-float.zero.4
386  (subtypep* '(double-float * -0.0d0) '(double-float * 0.0d0))
387  t t)
388
389(deftest subtypep.double-float.zero.5
390  (subtypep* '(double-float (-0.0d0) *) '(double-float (0.0d0) *))
391  t t)
392
393(deftest subtypep.double-float.zero.6
394  (subtypep* '(double-float * (-0.0d0)) '(double-float * (0.0d0)))
395  t t)
396
397(deftest subtypep.double-float.zero.7
398  (subtypep* '(double-float 0.0d0 *) '(double-float -0.0d0 *))
399  t t)
400
401(deftest subtypep.double-float.zero.8
402  (subtypep* '(double-float * 0.0d0) '(double-float * -0.0d0))
403  t t)
404
405(deftest subtypep.double-float.zero.9
406  (subtypep* '(double-float (0.0d0) *) '(double-float (-0.0d0) *))
407  t t)
408
409(deftest subtypep.double-float.zero.10
410  (subtypep* '(double-float * (0.0d0)) '(double-float * (-0.0d0)))
411  t t)
Note: See TracBrowser for help on using the repository browser.