source: trunk/source/tests/ansi-tests/typep.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.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Mon May 23 07:13:32 2005
4;;;; Contains: Tests of TYPEP
5
6(in-package :cl-test)
7
8(deftest typep.error.1
9  (signals-error (typep) program-error)
10  t)
11
12(deftest typep.error.2
13  (signals-error (typep nil) program-error)
14  t)
15
16(deftest typep.error.3
17  (signals-error (typep nil t nil nil) program-error)
18  t)
19
20(deftest typep.error.4
21  (signals-error-always (typep nil 'values) error)
22  t t)
23
24(deftest typep.error.5
25  (signals-error-always (typep nil '(values)) error)
26  t t)
27
28(deftest typep.error.6
29  (signals-error-always (typep nil '(values t t t t)) error)
30  t t)
31
32(deftest typep.error.7
33  (signals-error-always (typep nil '(function () t)) error)
34  t t)
35
36;;; Non-error tests
37;;; Many more tests use typep when testing other functions
38
39(deftest typep-nil-null
40  (notnot-mv (typep nil 'null))
41  t)
42
43(deftest typep-t-null
44  (typep t 'null)
45  nil)
46
47;;; Tests of env arguments to typep
48
49(deftest typep.env.1
50  (notnot-mv (typep 0 'bit nil))
51  t)
52
53(deftest typep.env.2
54  (macrolet ((%foo (&environment env)
55                   (notnot-mv (typep 0 'bit env))))
56    (%foo))
57  t)
58
59(deftest typep.env.3
60  (macrolet ((%foo (&environment env)
61                   (notnot-mv (typep env (type-of env)))))
62    (%foo))
63  t)
64
65;;; Other typep tests
66
67(deftest typep.1
68  (notnot-mv (typep 'a '(eql a)))
69  t)
70
71(deftest typep.2
72  (notnot-mv (typep 'a '(and (eql a))))
73  t)
74
75(deftest typep.3
76  (notnot-mv (typep 'a '(or (eql a))))
77  t)
78
79(deftest typep.4
80  (typep 'a '(eql b))
81  nil)
82
83(deftest typep.5
84  (typep 'a '(and (eql b)))
85  nil)
86
87(deftest typep.6
88  (typep 'a '(or (eql b)))
89  nil)
90
91(deftest typep.7
92  (notnot-mv (typep 'a '(satisfies symbolp)))
93  t)
94
95(deftest typep.8
96  (typep 10 '(satisfies symbolp))
97  nil)
98
99(deftest typep.9
100  (let ((class (find-class 'symbol)))
101    (notnot-mv (typep 'a class)))
102  t)
103
104(deftest typep.10
105  (let ((class (find-class 'symbol)))
106    (notnot-mv (typep 'a `(and ,class))))
107  t)
108
109(deftest typep.11
110  (let ((class (find-class 'symbol)))
111    (typep 10 class))
112  nil)
113
114(deftest typep.12
115  (let ((class (find-class 'symbol)))
116    (typep 10 `(and ,class)))
117  nil)
118
119(deftest typep.13
120  (typep 'a '(and symbol integer))
121  nil)
122
123(deftest typep.14
124  (notnot-mv (typep 'a '(or symbol integer)))
125  t)
126
127(deftest typep.15
128  (notnot-mv (typep 'a '(or integer symbol)))
129  t)
130
131(deftest typep.16
132  (let ((c1 (find-class 'number))
133        (c2 (find-class 'symbol)))
134    (notnot-mv (typep 'a `(or ,c1 ,c2))))
135  t)
136
137(deftest typep.17
138  (let ((c1 (find-class 'number))
139        (c2 (find-class 'symbol)))
140    (notnot-mv (typep 'a `(or ,c2 ,c1))))
141  t)
142
143(deftest typep.18
144  (let ((i 0))
145    (values
146     (notnot (typep (incf i) '(and (integer 0 10) (integer -5 6))))
147     i))
148  t 1)
149
150(defun typep.19-fn (reps &optional (prob .5))
151  (let* ((vec "abcdefghijklmnopqrstuvwxyz"))
152    (flet ((%make-random-type
153            ()
154            `(and character (member ,@(loop for e across vec
155                                            when (< (random 1.0) prob)
156                                            collect e)))))
157      (loop
158       for t1 = (%make-random-type)
159       for t2 = (%make-random-type)
160       for t3 = `(and ,t1 ,t2)
161       for result1 = (loop for e across vec
162                           when (if (typep e t3)
163                                    (or (not (typep e t1)) (not (typep e t2)))
164                                  (and (typep e t1) (typep e t2)))
165                           collect e)
166       repeat reps
167       when result1
168       nconc (list result1 t1 t2 t3)))))
169
170(eval-when (:load-toplevel) (compile 'typep.19-fn))
171
172(deftest typep.19 (typep.19-fn 1000) nil)
173
174           
175                             
Note: See TracBrowser for help on using the repository browser.