source: trunk/source/tests/ansi-tests/coerce.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: 4.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Dec 13 20:48:04 2002
4;;;; Contains: Tests for COERCE
5
6(in-package :cl-test)
7
8(deftest coerce.1
9  (check-predicate #'(lambda (x)
10                       (let ((type (type-of x)))
11                         (or (and (consp type) (eqt (car type) 'function))
12                             (eql (coerce x type) x)))))
13  nil)
14
15(deftest coerce.2
16  (check-predicate #'(lambda (x) (eql (coerce x t) x)))
17  nil)
18
19(deftest coerce.3
20  (check-predicate
21   #'(lambda (x)
22       (let ((class (class-of x)))
23         (eql (coerce x class) x))))
24  nil)
25
26(deftest coerce.4
27  (loop for x in '(() #() #*)
28        never (coerce x 'list))
29  t)
30
31(deftest coerce.5
32  (loop for x in '((1 0) #(1 0) #*10)
33        always (equal (coerce x 'list) '(1 0)))           
34  t)
35
36(deftest coerce.6
37  (loop for x in '(() #() #*)
38        always (equalp (coerce x 'vector) #()))
39  t)
40
41(deftest coerce.7
42  (loop for x in '((1 0) #(1 0) #*10)
43        for y = (coerce x 'vector)
44        always (and (equalp y #(1 0))
45                    (vectorp y)))
46  t)
47
48(deftest coerce.8
49  (loop for x in '((1 0) #(1 0) #*10)
50        for y = (coerce x '(vector *))
51        always (and (equalp y #(1 0))
52                    (vectorp y)))
53  t)
54
55(deftest coerce.9
56  (loop for x in '((1 0) #(1 0) #*10)
57        for y = (coerce x '(vector * 2))
58        always (and (equalp y #(1 0))
59                    (vectorp y)))
60  t)
61
62(deftest coerce.10
63  (values (coerce #\A 'character)
64          (coerce '|A| 'character)
65          (coerce "A" 'character))
66  #\A #\A #\A)
67
68(deftest coerce.11
69  (loop with class = (find-class 'vector)
70        for x in '((1 0) #(1 0) #*10)
71        for y = (coerce x class)
72        always (and (equalp y #(1 0))
73                    (vectorp y)))
74  t)
75
76(deftest coerce.12
77  (loop for x in '((1 0) #(1 0) #*10)
78        for y = (coerce x 'bit-vector)
79        always (and (equalp y #*10)
80                    (bit-vector-p y)))
81  t)
82
83(deftest coerce.13
84  (loop for x in '((#\a #\b #\c) "abc")
85        for y = (coerce x 'string)
86        always (and (stringp y)
87                    (string= y "abc")))
88  t)
89
90(deftest coerce.14
91  (loop for x in '((#\a #\b #\c) "abc")
92        for y = (coerce x 'simple-string)
93        always (and (typep y 'simple-string)
94                    (string= y "abc")))
95  t)
96
97(deftest coerce.15
98  (loop for x in '((1 0) #(1 0) #*10)
99        for y = (coerce x 'simple-vector)
100        always (and (equalp y #(1 0))
101                    (simple-vector-p y)))
102  t)
103
104(deftest coerce.16
105  (coerce 0 'integer)
106  0)
107
108(deftest coerce.17
109  (coerce 0 'complex)
110  0)
111
112(deftest coerce.18
113  (coerce 3 'complex)
114  3)
115
116(deftest coerce.19
117  (coerce 5/3 'complex)
118  5/3)
119
120(deftest coerce.20
121  (coerce 1.0 'complex)
122  #c(1.0 0.0))
123
124(deftest coerce.21
125  (eqt (symbol-function 'car)
126       (coerce 'car 'function))
127  t)
128
129(deftest coerce.22
130  (funcall (coerce '(lambda () 10) 'function))
131  10)
132
133(deftest coerce.order.1
134  (let ((i 0) a b)
135    (values
136     (coerce (progn (setf a (incf i)) 10)
137             (progn (setf b (incf i)) 'single-float))
138     i a b))
139  10.0f0 2 1 2)
140
141;;; Constant folding test
142;;; If the coerce call is folded to a constant, this will fail
143;;; when that constant is modified.
144
145(def-fold-test coerce.fold.1 (coerce '(1 2 3) 'vector))
146(def-fold-test coerce.fold.2 (coerce '(1 0 1) 'bit-vector))
147(def-fold-test coerce.fold.3 (coerce '(#\a #\b #\c) 'string))
148
149;;; Error tests
150
151;;; (deftest coerce.error.1
152;;;  (signals-error (coerce -1 '(integer 0 100)) type-error)
153;;;  t)
154
155(deftest coerce.error.2
156  (signals-error (coerce '(a b c) '(vector * 2)) type-error)
157  t)
158
159(deftest coerce.error.3
160  (signals-error (coerce '(a b c) '(vector * 4)) type-error)
161  t)
162
163(deftest coerce.error.4
164  (signals-error (coerce nil 'cons) type-error)
165  t)
166
167(deftest coerce.error.5
168  (handler-case
169   (eval '(coerce 'not-a-bound-function 'function))
170   (error () :caught))
171  :caught)
172
173(deftest coerce.error.6
174  (signals-error (coerce) program-error)
175  t)
176
177(deftest coerce.error.7
178  (signals-error (coerce t) program-error)
179  t)
180
181(deftest coerce.error.8
182  (signals-error (coerce 'x t 'foo) program-error)
183  t)
184
185(deftest coerce.error.9
186  (signals-error (locally (coerce nil 'cons) t) type-error)
187  t)
188
189(deftest coerce.error.10
190  :notes (:result-type-element-type-by-subtype)
191  (let* ((tp1 '(vector character))
192         (tp2 `(vector t))
193         (tp3 `(or ,tp1 ,tp2)))
194    (if (not (subtypep tp3 'vector))
195        t
196      (handler-case
197       (eval `(coerce '(#\a #\b #\c) ',tp3))
198       (type-error (c)
199         (cond
200          ((typep (type-error-datum c)
201                  (type-error-expected-type c))
202           `((typep ',(type-error-datum c)
203                    ',(type-error-expected-type c))
204             "==>" true))
205          (t t)))
206       (error (c) (declare (ignore c)) t))))
207  t)
Note: See TracBrowser for help on using the repository browser.