/[gcl]/gcl/ansi-tests/subtypep-float.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/subtypep-float.lsp

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

revision 1.1 by pfdietz, Sat Feb 15 18:04:16 2003 UTC revision 1.2 by pfdietz, Thu Apr 24 00:55:43 2003 UTC
# Line 173  Line 173 
173                             (long-float 1.0l0 3.0l0))                             (long-float 1.0l0 3.0l0))
174                       '(long-float 1.0l0 2.0l0))                       '(long-float 1.0l0 2.0l0))
175    nil)    nil)
176    
177    ;;; Signed zero tests
178    
179    (deftest subtypep.short-float.zero.1
180      (check-equivalence '(short-float 0.0s0 *)
181                         '(or (short-float (0.0s0) *)
182                              (member -0.0s0 0.0s0)))
183      nil)
184    
185    (unless (eql 0.0s0 -0.0s0)
186      (deftest subtypep.short-float.zero.2
187        (values (subtypep '(short-float 0.0s0)
188                          '(or (short-float (0.0s0)) (member 0.0s0))))
189        nil)
190      (deftest subtypep.short-float.zero.
191        (values (subtypep '(short-float 0.0s0)
192                          '(or (short-float (0.0s0)) (member -0.0s0))))
193        nil))
194    
195    (deftest subtypep.short-float.zero.3
196      (subtypep* '(short-float -0.0s0 *) '(short-float 0.0s0 *))
197      t t)
198    
199    (deftest subtypep.short-float.zero.4
200      (subtypep* '(short-float * -0.0s0) '(short-float * 0.0s0))
201      t t)
202    
203    (deftest subtypep.short-float.zero.5
204      (subtypep* '(short-float (-0.0s0) *) '(short-float (0.0s0) *))
205      t t)
206    
207    (deftest subtypep.short-float.zero.6
208      (subtypep* '(short-float * (-0.0s0)) '(short-float * (0.0s0)))
209      t t)
210    
211    (deftest subtypep.short-float.zero.7
212      (subtypep* '(short-float 0.0s0 *) '(short-float -0.0s0 *))
213      t t)
214    
215    (deftest subtypep.short-float.zero.8
216      (subtypep* '(short-float * 0.0s0) '(short-float * -0.0s0))
217      t t)
218    
219    (deftest subtypep.short-float.zero.9
220      (subtypep* '(short-float (0.0s0) *) '(short-float (-0.0s0) *))
221      t t)
222    
223    (deftest subtypep.short-float.zero.10
224      (subtypep* '(short-float * (0.0s0)) '(short-float * (-0.0s0)))
225      t t)
226    
227    ;;;
228    
229    (deftest subtypep.float.zero.1
230      (check-equivalence '(float 0.0 *)
231                         '(or (float (0.0) *)
232                              (member -0.0 0.0)))
233      nil)
234    
235    (unless (eql 0.0 -0.0)
236      (deftest subtypep.float.zero.2
237        (values (subtypep '(float 0.0)
238                          '(or (float (0.0)) (member 0.0))))
239        nil)
240      (deftest subtypep.float.zero.
241        (values (subtypep '(float 0.0)
242                          '(or (float (0.0)) (member -0.0))))
243        nil))
244    
245    (deftest subtypep.float.zero.3
246      (subtypep* '(float -0.0 *) '(float 0.0 *))
247      t t)
248    
249    (deftest subtypep.float.zero.4
250      (subtypep* '(float * -0.0) '(float * 0.0))
251      t t)
252    
253    (deftest subtypep.float.zero.5
254      (subtypep* '(float (-0.0) *) '(float (0.0) *))
255      t t)
256    
257    (deftest subtypep.float.zero.6
258      (subtypep* '(float * (-0.0)) '(float * (0.0)))
259      t t)
260    
261    (deftest subtypep.float.zero.7
262      (subtypep* '(float 0.0 *) '(float -0.0 *))
263      t t)
264    
265    (deftest subtypep.float.zero.8
266      (subtypep* '(float * 0.0) '(float * -0.0))
267      t t)
268    
269    (deftest subtypep.float.zero.9
270      (subtypep* '(float (0.0) *) '(float (-0.0) *))
271      t t)
272    
273    (deftest subtypep.float.zero.10
274      (subtypep* '(float * (0.0)) '(float * (-0.0)))
275      t t)
276    
277    ;;;
278    
279    (deftest subtypep.single-float.zero.1
280      (check-equivalence '(single-float 0.0f0 *)
281                         '(or (single-float (0.0f0) *)
282                              (member -0.0f0 0.0f0)))
283      nil)
284    
285    (unless (eql 0.0f0 -0.0f0)
286      (deftest subtypep.single-float.zero.2
287        (values (subtypep '(single-float 0.0f0)
288                          '(or (single-float (0.0f0)) (member 0.0f0))))
289        nil)
290      (deftest subtypep.single-float.zero.
291        (values (subtypep '(single-float 0.0f0)
292                          '(or (single-float (0.0f0)) (member -0.0f0))))
293        nil))
294    
295    (deftest subtypep.single-float.zero.3
296      (subtypep* '(single-float -0.0f0 *) '(single-float 0.0f0 *))
297      t t)
298    
299    (deftest subtypep.single-float.zero.4
300      (subtypep* '(single-float * -0.0f0) '(single-float * 0.0f0))
301      t t)
302    
303    (deftest subtypep.single-float.zero.5
304      (subtypep* '(single-float (-0.0f0) *) '(single-float (0.0f0) *))
305      t t)
306    
307    (deftest subtypep.single-float.zero.6
308      (subtypep* '(single-float * (-0.0f0)) '(single-float * (0.0f0)))
309      t t)
310    
311    (deftest subtypep.single-float.zero.7
312      (subtypep* '(single-float 0.0f0 *) '(single-float -0.0f0 *))
313      t t)
314    
315    (deftest subtypep.single-float.zero.8
316      (subtypep* '(single-float * 0.0f0) '(single-float * -0.0f0))
317      t t)
318    
319    (deftest subtypep.single-float.zero.9
320      (subtypep* '(single-float (0.0f0) *) '(single-float (-0.0f0) *))
321      t t)
322    
323    (deftest subtypep.single-float.zero.10
324      (subtypep* '(single-float * (0.0f0)) '(single-float * (-0.0f0)))
325      t t)
326    
327    ;;;
328    
329    (deftest subtypep.long-float.zero.1
330      (check-equivalence '(long-float 0.0l0 *)
331                         '(or (long-float (0.0l0) *)
332                              (member -0.0l0 0.0l0)))
333      nil)
334    
335    (unless (eql 0.0l0 -0.0l0)
336      (deftest subtypep.long-float.zero.2
337        (values (subtypep '(long-float 0.0l0)
338                          '(or (long-float (0.0l0)) (member 0.0l0))))
339        nil)
340      (deftest subtypep.long-float.zero.
341        (values (subtypep '(long-float 0.0l0)
342                          '(or (long-float (0.0l0)) (member -0.0l0))))
343        nil))
344    
345    (deftest subtypep.long-float.zero.3
346      (subtypep* '(long-float -0.0l0 *) '(long-float 0.0l0 *))
347      t t)
348    
349    (deftest subtypep.long-float.zero.4
350      (subtypep* '(long-float * -0.0l0) '(long-float * 0.0l0))
351      t t)
352    
353    (deftest subtypep.long-float.zero.5
354      (subtypep* '(long-float (-0.0l0) *) '(long-float (0.0l0) *))
355      t t)
356    
357    (deftest subtypep.long-float.zero.6
358      (subtypep* '(long-float * (-0.0l0)) '(long-float * (0.0l0)))
359      t t)
360    
361    (deftest subtypep.long-float.zero.7
362      (subtypep* '(long-float 0.0l0 *) '(long-float -0.0l0 *))
363      t t)
364    
365    (deftest subtypep.long-float.zero.8
366      (subtypep* '(long-float * 0.0l0) '(long-float * -0.0l0))
367      t t)
368    
369    (deftest subtypep.long-float.zero.9
370      (subtypep* '(long-float (0.0l0) *) '(long-float (-0.0l0) *))
371      t t)
372    
373    (deftest subtypep.long-float.zero.10
374      (subtypep* '(long-float * (0.0l0)) '(long-float * (-0.0l0)))
375      t t)
376    
377    ;;;
378    
379    (deftest subtypep.double-float.zero.1
380      (check-equivalence '(double-float 0.0d0 *)
381                         '(or (double-float (0.0d0) *)
382                              (member -0.0d0 0.0d0)))
383      nil)
384    
385    (unless (eql 0.0d0 -0.0d0)
386      (deftest subtypep.double-float.zero.2
387        (values (subtypep '(double-float 0.0d0)
388                          '(or (double-float (0.0d0)) (member 0.0d0))))
389        nil)
390      (deftest subtypep.double-float.zero.
391        (values (subtypep '(double-float 0.0d0)
392                          '(or (double-float (0.0d0)) (member -0.0d0))))
393        nil))
394    
395    (deftest subtypep.double-float.zero.3
396      (subtypep* '(double-float -0.0d0 *) '(double-float 0.0d0 *))
397      t t)
398    
399    (deftest subtypep.double-float.zero.4
400      (subtypep* '(double-float * -0.0d0) '(double-float * 0.0d0))
401      t t)
402    
403    (deftest subtypep.double-float.zero.5
404      (subtypep* '(double-float (-0.0d0) *) '(double-float (0.0d0) *))
405      t t)
406    
407    (deftest subtypep.double-float.zero.6
408      (subtypep* '(double-float * (-0.0d0)) '(double-float * (0.0d0)))
409      t t)
410    
411    (deftest subtypep.double-float.zero.7
412      (subtypep* '(double-float 0.0d0 *) '(double-float -0.0d0 *))
413      t t)
414    
415    (deftest subtypep.double-float.zero.8
416      (subtypep* '(double-float * 0.0d0) '(double-float * -0.0d0))
417      t t)
418    
419    (deftest subtypep.double-float.zero.9
420      (subtypep* '(double-float (0.0d0) *) '(double-float (-0.0d0) *))
421      t t)
422    
423    (deftest subtypep.double-float.zero.10
424      (subtypep* '(double-float * (0.0d0)) '(double-float * (-0.0d0)))
425      t t)

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

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