source: trunk/source/tests/ansi-tests/upgraded-array-element-type.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: 3.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Jan 22 20:43:55 2003
4;;;; Contains: Tests of UPGRADED-ARRAY-ELEMENT-TYPE
5
6(in-package :cl-test)
7
8(deftest upgraded-array-element-type.1
9  (let ((upgraded-bit (upgraded-array-element-type 'bit)))
10    (and (empirical-subtypep 'bit upgraded-bit)
11         (empirical-subtypep upgraded-bit 'bit)))
12  t)
13
14(deftest upgraded-array-element-type.2
15  (let ((upgraded-base-char (upgraded-array-element-type 'base-char)))
16    (and (empirical-subtypep 'base-char upgraded-base-char)
17         (empirical-subtypep upgraded-base-char 'base-char)))
18  t)
19
20(deftest upgraded-array-element-type.3
21  (let ((upgraded-character (upgraded-array-element-type 'character)))
22    (and (empirical-subtypep 'character upgraded-character)
23         (empirical-subtypep upgraded-character 'character)))
24  t)
25
26(defparameter *upgraded-array-types-to-check*
27  `(boolean
28    base-char
29    character
30    t
31    ,@(loop for i from 0 to 32 collect `(eql ,(ash 1 i)))
32    ,@(loop for i from 0 to 32 collect `(eql ,(1- (ash 1 i))))
33    (eql -1)
34    ,@(loop for i from 0 to 32
35            collect `(integer 0 (,(ash 1 i))))
36    symbol
37    ,@(loop for i from 0 to 32
38            collect `(integer ,(- (ash 1 i)) (,(ash 1 i))))
39    (integer -10000000000000000000000000000000000
40             10000000000000000000000000000000000)
41    float
42    short-float
43    single-float
44    double-float
45    complex
46    rational
47    fixnum
48    function
49    sequence
50    list
51    cons
52    atom
53    symbol))
54
55(deftest upgraded-array-element-type.4
56  (loop for type in *upgraded-array-types-to-check*
57        for upgraded-type = (upgraded-array-element-type type)
58        unless (empirical-subtypep type upgraded-type)
59        collect (list type upgraded-type))
60  nil)
61
62;; Include an environment (NIL, denoting the default null lexical
63;; environment)
64
65(deftest upgraded-array-element-type.5
66  (loop for type in *upgraded-array-types-to-check*
67        for upgraded-type = (upgraded-array-element-type type nil)
68        unless (empirical-subtypep type upgraded-type)
69        collect (list type upgraded-type))
70  nil)
71
72(deftest upgraded-array-element-type.6
73  (macrolet
74      ((%foo (&environment env)
75             (empirical-subtypep
76              'bit
77              (upgraded-array-element-type 'bit env))))
78    (%foo))
79  t)
80
81(deftest upgraded-array-element-type.7
82  (let ((upgraded-types (mapcar #'upgraded-array-element-type
83                                *upgraded-array-types-to-check*)))
84    (loop for type in *upgraded-array-types-to-check*
85          for upgraded-type in upgraded-types
86          append
87          (loop for type2 in *upgraded-array-types-to-check*
88                for upgraded-type2 in upgraded-types
89                when (and (subtypep type type2)
90                          (equal (subtypep* upgraded-type upgraded-type)
91                                 '(nil t)))
92                collect (list type type2))))
93  nil)
94
95;;; Tests that if Tx is a subtype of Ty, then UAET(Tx) is a subtype
96;;;  of UAET(Ty)  (see section 15.1.2.1, paragraph 3)
97
98(deftest upgraded-array-element-type.8
99  (let ((upgraded-types (mapcar #'upgraded-array-element-type
100                                *upgraded-array-types-to-check*)))
101    (loop for type1 in *upgraded-array-types-to-check*
102          for uaet1 in upgraded-types
103          append
104          (loop for type2 in *upgraded-array-types-to-check*
105                for uaet2 in upgraded-types
106                when (and (subtypep type1 type2)
107                        (not (empirical-subtypep uaet1 uaet2)))
108                collect (list type1 type2))))
109  nil)
110
111;;; Tests of upgrading NIL (it should be type equivalent to NIL)
112
113(deftest upgraded-array-element-type.nil.1
114  (let ((uaet-nil (upgraded-array-element-type nil)))
115    (check-predicate (typef `(not ,uaet-nil))))
116  nil)
117   
118;;; Error tests
119
120(deftest upgraded-array-element-type.error.1
121  (signals-error (upgraded-array-element-type) program-error)
122  t)
123
124(deftest upgraded-array-element-type.error.2
125  (signals-error (upgraded-array-element-type 'bit nil nil) program-error)
126  t)
Note: See TracBrowser for help on using the repository browser.