source: trunk/source/tests/ansi-tests/upgraded-complex-part-type.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 3.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Nov 27 21:15:46 2004
4;;;; Contains: Tests of UPGRADE-COMPLEX-PART-TYPE
5
6(in-package :cl-test)
7
8(compile-and-load "types-aux.lsp")
9
10(defmacro def-ucpt-test (name types)
11  `(deftest ,name
12     (loop for type in (remove-duplicates ,types)
13           for upgraded-type = (upgraded-complex-part-type type)
14           for result = (append (check-all-subtypep type upgraded-type)
15                                (check-all-subtypep type 'real)
16                                (check-all-subtypep `(complex ,type) 'complex)
17                                (check-all-subtypep `(complex ,upgraded-type)
18                                                    'complex)
19                                (check-all-subtypep `(complex ,type)
20                                                    `(complex ,upgraded-type)))
21           when result
22           collect result)
23     nil))
24
25(def-ucpt-test upgraded-complex-part-type.1
26  '(real integer rational ratio float short-float single-float
27    double-float long-float fixnum bignum bit unsigned-byte signed-byte))
28
29(def-ucpt-test upgraded-complex-part-type.2
30  (mapcar #'find-class '(real float integer rational ratio)))
31
32(def-ucpt-test upgraded-complex-part-type.3
33  (mapcar #'class-of '(1.0s0 1.0f0 1.0d0 1.0l0)))
34
35(def-ucpt-test upgraded-complex-part-type.4
36  (loop for i from 1 to 100 collect `(unsigned-byte ,i)))
37
38(def-ucpt-test upgraded-complex-part-type.5
39  (loop for i from 1 to 100 collect `(signed-byte ,i)))
40
41(def-ucpt-test upgraded-complex-part-type.6
42  (loop for i = 1 then (* i 2)
43        repeat 100
44        collect (class-of i)))
45
46;;; environment argument
47
48(deftest upgraded-complex-part-type.7
49  (loop for type in '(real integer rational float short-float
50                      single-float double-float long-float fixnum
51                      bignum bit unsigned-byte signed-byte)
52        for ut1 = (upgraded-complex-part-type type)
53        for ut2 = (upgraded-complex-part-type type nil)
54        unless (equal ut1 ut2)
55        collect (list type ut1 ut2))
56  nil)
57
58(deftest upgraded-complex-part-type.8
59  (loop for type in '(real integer rational float short-float
60                      single-float double-float long-float fixnum
61                      bignum bit unsigned-byte signed-byte)
62        for ut1 = (upgraded-complex-part-type type)
63        for ut2 = (eval `(macrolet ((%m (&environment env)
64                                        (list 'quote
65                                              (upgraded-complex-part-type ',type env))))
66                           (%m)))
67        unless (equal ut1 ut2)
68        collect (list type ut1 ut2))
69  nil)
70
71;;; Subtype constraint
72
73(deftest upgraded-complex-part-type.9
74  (let* ((types `(nil integer fixnum bignum float
75                     short-float single-float double-float long-float
76                     rational #-sbcl ratio real
77                     ,@(remove-duplicates
78                        (mapcar #'class-of '(0.0s0 0.0f0 0.0d0 0.0l0 0 100000000000000000)))
79                     ,@(mapcar #'(lambda (x) `(eql ,x))
80                               (remove-duplicates
81                                '(0.0s0 0.0f0 0.0d0 0.0l0 0
82                                  1.0s0 1.0f0 1.0d0 1.0l0 1
83                                  100000000000000000)))))
84         (utypes (mapcar #'upgraded-complex-part-type types)))
85    (loop for sublist on types
86          for usublist on utypes
87          for tp1 = (car sublist)
88          for utp1 = (car usublist)
89          nconc (loop for tp2 in (cdr sublist)
90                      for utp2 in (cdr usublist)
91                      nconc
92                      (and (subtypep tp1 tp2)
93                           (let ((result (check-all-subtypep utp1 utp2)))
94                             (and result
95                                  (list (list tp1 tp2 result))))))))
96  nil)               
97
98;;; Error tests
99
100(deftest upgraded-complex-part-type.error.1
101  (signals-error (upgraded-complex-part-type) program-error)
102  t)
103
104(deftest upgraded-complex-part-type.error.2
105  (signals-error (upgraded-complex-part-type 'real nil nil) program-error)
106  t)
Note: See TracBrowser for help on using the repository browser.