source: trunk/source/tests/ansi-tests/type-of.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.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Jun  4 21:15:05 2003
4;;;; Contains: Tests of TYPE-OF
5
6(in-package :cl-test)
7
8;;;  It turns out I left out an important test of type-of:
9;;;  (type-of x) must be a recognizable subtype of every builtin type
10;;;  of which x is a member.
11
12(deftest type-of.1
13  :notes :type-of/strict-builtins
14  (loop for x in *universe*
15        for tp = (type-of x)
16        for failures = (loop for tp2 in *cl-all-type-symbols*
17                             when (and (typep x tp2)
18                                       (not (subtypep tp tp2)))
19                             collect tp2)
20        when failures collect (list x failures))
21  nil)
22
23;;; Some have objected to that (in type-of.1) interpretation
24;;; of req. 1.a in the TYPE-OF page, saying that it need hold
25;;; for only *one* builtin type that the object is an element of.
26;;; This test tests the relaxed requirement.
27
28(deftest type-of.1-relaxed
29  (loop for x in *universe*
30        for builtins = (remove x *cl-all-type-symbols*
31                               :test (complement #'typep))
32        for tp = (type-of x)
33        when (and builtins
34                  (not (loop for tp2 in builtins
35                             thereis (subtypep tp tp2))))
36        collect x)
37  nil)
38
39;;; 1. For any object that is an element of some built-in type:
40;;;  b. the type returned does not involve and, eql, member, not,
41;;;     or, satisfies, or values.
42;;;
43;;; Since every object is an element of the built-in type T, this
44;;; applies universally.
45
46(deftest type-of.2
47  (loop for x in *universe*
48        for tp = (type-of x)
49        when (and (consp tp)
50                  (member (car tp) '(and eql member not or satisfies values
51                                         function)))
52        collect x)
53  nil)
54
55(deftest type-of.3
56  (loop for x in *universe*
57        unless (typep x (type-of x))
58        collect x)
59  nil)
60
61(deftest type-of.4
62  (loop for x in *universe*
63        for tp = (type-of x)
64        for class = (class-of x)
65        unless (equal (multiple-value-list (subtypep* tp class)) '(t t))
66        collect x)
67  nil)
68
69(deftest type-of.5
70  (loop for x in *cl-condition-type-symbols*
71        for cnd = (make-condition x)
72        for tp = (type-of cnd)
73        unless (eq x tp)
74        collect x)
75  nil)
76
77(defstruct type-of.example-struct a b c)
78
79(deftest type-of.6
80  (type-of (make-type-of.example-struct))
81  type-of.example-struct)
82
83(defclass type-of.example-class () ())
84
85(deftest type-of.7
86  (type-of (make-instance 'type-of.example-class))
87  type-of.example-class)
88
89(deftest type-of.8
90  (let ((class (eval '(defclass type-of.example-class-2 () ((a) (b) (c))))))
91    (setf (class-name class) nil)
92    (eqt (type-of (make-instance class)) class))
93  t)
94
95(deftest type-of.9
96  (let ((class (eval '(defclass type-of.example-class-3 () ((a) (b) (c))))))
97    (setf (find-class 'type-of.example-class-3) nil)
98    (eqt (type-of (make-instance class)) class))
99  t)
100
101(deftest type-of.10
102  (let* ((class (eval '(defclass type-of.example-class-4 () ((a) (b) (c)))))
103         (obj (make-instance class)))
104    (setf (class-name class) nil)
105    (notnot-mv (typep obj class)))
106  t)
107
108(deftest type-of.11
109  (let* ((c #c(-1 1/2))
110         (type (type-of c)))
111    (notnot (typep c type)))
112  t)
113
114;;; Error tests
115
116(deftest type-of.error.1
117  (signals-error (type-of) program-error)
118  t)
119
120(deftest type-of.error.2
121  (signals-error (type-of nil nil) program-error)
122  t) 
123
Note: See TracBrowser for help on using the repository browser.