source: trunk/source/tests/ansi-tests/deftype.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.2 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Apr 20 12:56:56 2003
4;;;; Contains: Tests of DEFTYPE
5
6(in-package :cl-test)
7
8(compile-and-load "types-aux.lsp")
9
10;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11;;; deftype
12
13(deftest deftype.1
14  (typep 1 '(even-array integer (10)))
15  nil)
16
17(deftest deftype.2
18  (typep nil '(even-array t (*)))
19  nil)
20
21(deftest deftype.3
22  (notnot-mv (typep (make-array '(10)) '(even-array t (*))))
23  t)
24
25(deftest deftype.4
26  (typep (make-array '(5)) '(even-array t (*)))
27  nil)
28
29(deftest deftype.5
30  (notnot-mv (typep (make-string 10) '(even-array character (*))))
31  t)
32
33(deftest deftype.6
34  (notnot-mv
35   (typep (make-array '(3 5 6) :element-type '(unsigned-byte 8))
36          '(even-array (unsigned-byte 8))))
37  t)
38
39(deftest deftype.7
40  (let ((sym (gensym)))
41    (assert (eq (eval `(deftype ,sym () '(integer 0 10))) sym))
42    (documentation sym 'type))
43  nil)
44
45(deftest deftype.8
46  (let ((sym (gensym)))
47    (assert (eq (eval `(deftype ,sym () "FOO" '(integer 0 10))) sym))
48    (or (documentation sym 'type) "FOO"))
49  "FOO")
50
51(deftest deftype.9
52  (let* ((sym (gensym))
53         (form `(deftype ,sym (&optional x) `(integer 0 ,x))))
54    (values
55     (eqlt (eval form) sym)
56     (multiple-value-list (subtypep* `(,sym) 'unsigned-byte))
57     (multiple-value-list (subtypep* 'unsigned-byte `(,sym)))
58     (multiple-value-list (subtypep* `(,sym 4) '(integer 0 4)))
59     (multiple-value-list (subtypep* '(integer 0 4) `(,sym 4)))
60     (loop for x in '(a -1 0 1 2 3 4 5 b)
61           collect (notnot (typep x sym)))
62     (loop for x in '(a -1 0 1 2 3 4 5 b)
63           collect (notnot (typep x `(,sym 4))))
64     ))
65  t (t t) (t t) (t t) (t t)
66  (nil nil t t t t t t nil)
67  (nil nil t t t t t nil nil))
68
69(deftest deftype.10
70  (let* ((sym (gensym))
71         (form `(deftype ,sym (&optional (x 14)) `(integer 0 ,x))))
72    (values
73     (eqlt (eval form) sym)
74     (multiple-value-list (subtypep* `(,sym) '(integer 0 14)))
75     (multiple-value-list (subtypep* '(integer 0 14) `(,sym)))
76     (multiple-value-list (subtypep* `(,sym 4) '(integer 0 4)))
77     (multiple-value-list (subtypep* '(integer 0 4) `(,sym 4)))
78     (loop for x in '(a -1 0 1 2 3 4 5 14 15 b)
79           collect (notnot (typep x sym)))
80     (loop for x in '(a -1 0 1 2 3 4 5 14 15 b)
81           collect (notnot (typep x `(,sym 4))))
82     ))
83  t (t t) (t t) (t t) (t t)
84  (nil nil t t t t t t t nil nil)
85  (nil nil t t t t t nil nil nil nil))
86
87(deftest deftype.11
88  (let* ((sym (gensym))
89         (form `(deftype ,sym (&key foo bar) `(integer ,foo ,bar))))
90    (values
91     (eqlt (eval form) sym)
92     (multiple-value-list (subtypep* `(,sym) 'integer))
93     (multiple-value-list (subtypep* 'integer `(,sym)))
94
95     (multiple-value-list (subtypep* `(,sym :allow-other-keys nil) 'integer))
96     (multiple-value-list (subtypep* 'integer `(,sym :allow-other-keys nil)))
97     (multiple-value-list (subtypep* `(,sym :xyz 17 :allow-other-keys t) 'integer))
98     (multiple-value-list (subtypep* 'integer `(,sym :allow-other-keys t abc nil)))
99
100     (multiple-value-list (subtypep* `(,sym :foo 3) '(integer 3)))
101     (multiple-value-list (subtypep* '(integer 3) `(,sym :foo 3)))
102     (multiple-value-list (subtypep* `(,sym :bar 10) '(integer * 10)))
103     (multiple-value-list (subtypep* '(integer * 10) `(,sym :bar 10)))
104
105     (multiple-value-list (subtypep* `(,sym :foo 3 :foo 4 :bar 6) '(integer 3 6)))
106     (multiple-value-list (subtypep* '(integer 3 6) `(,sym :foo 3 :foo 4 :bar 6)))
107     (multiple-value-list (subtypep* `(,sym :bar * :foo (1)) '(integer 2)))
108     (multiple-value-list (subtypep* '(integer 2) `(,sym :bar * :foo (1))))
109     ))
110  t
111  (t t) (t t)
112  (t t) (t t) (t t) (t t)
113  (t t) (t t) (t t) (t t)
114  (t t) (t t) (t t) (t t)
115  )
116
117(deftest deftype.12
118  (let* ((sym (gensym))
119         (form `(deftype ,sym (&key foo bar &allow-other-keys) `(integer ,foo ,bar))))
120    (values
121     (eqlt (eval form) sym)
122     (multiple-value-list (subtypep* `(,sym :xyz t) 'integer))
123     (multiple-value-list (subtypep* 'integer `(,sym :xyz t)))
124
125     (multiple-value-list (subtypep* `(,sym :allow-other-keys nil abc t) 'integer))
126     (multiple-value-list (subtypep* 'integer `(,sym :allow-other-keys nil abc t)))
127     (multiple-value-list (subtypep* `(,sym :foo -10 :bar 20) '(integer -10 20)))
128     (multiple-value-list (subtypep* '(integer -10 20) `(,sym :foo -10 :bar 20)))
129     ))
130  t
131  (t t) (t t)
132  (t t) (t t) (t t) (t t)
133  )
134
135(deftest deftype.13
136  (let* ((sym (gensym))
137         (form `(deftype ,sym (&rest args) (if args `(member ,@args) nil))))
138    (values
139     (eqlt (eval form) sym)
140;;     (multiple-value-list (subtypep* sym nil))
141;;     (multiple-value-list (subtypep* nil sym))
142     (multiple-value-list (subtypep* `(,sym) nil))
143     (multiple-value-list (subtypep* nil `(,sym)))
144     (notnot (typep 'a `(,sym a)))
145     (notnot (typep 'b `(,sym a)))
146     (notnot (typep '* `(,sym a)))
147     (notnot (typep 'a `(,sym a b)))
148     (notnot (typep 'b `(,sym a b)))
149     (notnot (typep 'c `(,sym a b)))))
150  t
151  (t t) (t t)
152  t nil nil t t nil)
153
154;;; I've removed this test, because EVAL can cause implicit compilation,
155;;; and the semantic constraints on compilation forbid redefinition of
156;;; of the types produced by DEFTYPE at runtime.
157#|
158(deftest deftype.14
159  (let* ((sym (gensym))
160         (*f* nil)
161         (form `(let ((x 1))
162                  (declare (special *f*))
163                  (setf *f* #'(lambda (y) (setf x y)))
164                  (deftype ,sym () `(integer 0 ,x)))))
165    (declare (special *f*))
166    (values
167     (eqlt (eval form) sym)
168     (loop for i from -1 to 3 collect (typep* i sym))
169     (funcall *f* 2)
170     (loop for i from -1 to 3 collect (typep* i sym))))
171  t (nil t t nil nil) 2 (nil t t t nil))
172|#
173
174(deftest deftype.15
175  (let* ((sym (gensym))
176         (form `(let ((a 1))
177                  (deftype ,sym (&optional (x a))
178                    (declare (special a))
179                    `(integer 0 ,x)))))
180    (values
181     (eqlt (eval form) sym)
182     (let ((a 2))
183       (declare (special a))
184       (loop for i from -1 to 3 collect (typep* i `(,sym 1))))
185     (let ((a 2))
186       (declare (special a))
187       (loop for i from -1 to 3 collect (typep* i sym)))))
188  t
189  (nil t t nil nil)
190  (nil t t nil nil))
191   
192(deftest deftype.16
193  (let* ((sym (gensym))
194         (form `(deftype ,sym () (return-from ,sym 'integer))))
195    (values
196     (eqlt (eval form) sym)
197     (subtypep* sym 'integer)
198     (subtypep* 'integer sym)))
199  t t t)
200
201(deftest deftype.17
202  (let* ((sym (gensym))
203         (form `(deftype ,sym () (values 'integer t))))
204    (values
205     (eqlt (eval form) sym)
206     (subtypep* sym 'integer)
207     (subtypep* 'integer sym)))
208  t t t)
209
210(deftest deftype.18
211  (let* ((sym (gensym))
212         (form `(deftype ,sym ())))
213    (values
214     (eqlt (eval form) sym)
215     (subtypep* sym nil)
216     (subtypep* nil sym)))
217  t t t)
218
219(deftest deftype.19
220  (let* ((sym (gensym))
221         (form `(deftype ,sym ()
222                  (declare (optimize speed safety debug compilation-speed space))
223                  'integer)))             
224    (values
225     (eqlt (eval form) sym)
226     (subtypep* sym 'integer)
227     (subtypep* 'integer sym)))
228  t t t)
229 
230;;; Error tests
231
232(deftest deftype.error.1
233  (signals-error (funcall (macro-function 'deftype))
234                 program-error)
235  t)
236
237(deftest deftype.error.2
238  (signals-error (funcall (macro-function 'deftype)
239                           '(deftype nonexistent-type () nil))
240                 program-error)
241  t)
242
243(deftest deftype.error.3
244  (signals-error (funcall (macro-function 'deftype)
245                           '(deftype nonexistent-type () nil)
246                           nil nil)
247                 program-error)
248  t)
249
Note: See TracBrowser for help on using the repository browser.