type-of.lsp 3.38 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Jun  4 21:15:05 2003
;;;; Contains: Tests of TYPE-OF

(in-package :cl-test)

;;;  It turns out I left out an important test of type-of:
;;;  (type-of x) must be a recognizable subtype of every builtin type
;;;  of which x is a member.

(deftest type-of.1
13
  :notes :type-of/strict-builtins
14
  (loop for x in *universe*
sds's avatar
sds committed
15 16 17 18 19 20
        for tp = (type-of x)
        for failures = (loop for tp2 in *cl-all-type-symbols*
                             when (and (typep x tp2)
                                       (not (subtypep tp tp2)))
                             collect tp2)
        when failures collect (list x failures))
21 22
  nil)

23 24 25 26 27 28 29
;;; Some have objected to that (in type-of.1) interpretation
;;; of req. 1.a in the TYPE-OF page, saying that it need hold
;;; for only *one* builtin type that the object is an element of.
;;; This test tests the relaxed requirement.

(deftest type-of.1-relaxed
  (loop for x in *universe*
sds's avatar
sds committed
30 31 32 33 34 35 36
        for builtins = (remove x *cl-all-type-symbols*
                               :test (complement #'typep))
        for tp = (type-of x)
        when (and builtins
                  (not (loop for tp2 in builtins
                             thereis (subtypep tp tp2))))
        collect x)
37 38
  nil)

39 40 41 42 43 44 45 46 47
;;; 1. For any object that is an element of some built-in type:
;;;  b. the type returned does not involve and, eql, member, not,
;;;     or, satisfies, or values.
;;;
;;; Since every object is an element of the built-in type T, this
;;; applies universally.

(deftest type-of.2
  (loop for x in *universe*
sds's avatar
sds committed
48 49 50 51 52
        for tp = (type-of x)
        when (and (consp tp)
                  (member (car tp) '(and eql member not or satisfies values
                                         function)))
        collect x)
53 54 55 56
  nil)

(deftest type-of.3
  (loop for x in *universe*
sds's avatar
sds committed
57 58
        unless (typep x (type-of x))
        collect x)
59 60 61 62
  nil)

(deftest type-of.4
  (loop for x in *universe*
sds's avatar
sds committed
63 64 65 66
        for tp = (type-of x)
        for class = (class-of x)
        unless (equal (multiple-value-list (subtypep* tp class)) '(t t))
        collect x)
67 68 69 70
  nil)

(deftest type-of.5
  (loop for x in *cl-condition-type-symbols*
sds's avatar
sds committed
71 72 73 74
        for cnd = (make-condition x)
        for tp = (type-of cnd)
        unless (eq x tp)
        collect x)
75 76
  nil)

77 78 79 80 81 82 83 84 85 86 87 88 89
(defstruct type-of.example-struct a b c)

(deftest type-of.6
  (type-of (make-type-of.example-struct))
  type-of.example-struct)

(defclass type-of.example-class () ())

(deftest type-of.7
  (type-of (make-instance 'type-of.example-class))
  type-of.example-class)

(deftest type-of.8
90 91 92 93 94 95 96 97 98
  (let ((class (eval '(defclass type-of.example-class-2 () ((a) (b) (c))))))
    (setf (class-name class) nil)
    (eqt (type-of (make-instance class)) class))
  t)

(deftest type-of.9
  (let ((class (eval '(defclass type-of.example-class-3 () ((a) (b) (c))))))
    (setf (find-class 'type-of.example-class-3) nil)
    (eqt (type-of (make-instance class)) class))
99 100
  t)

pfdietz's avatar
pfdietz committed
101 102
(deftest type-of.10
  (let* ((class (eval '(defclass type-of.example-class-4 () ((a) (b) (c)))))
sds's avatar
sds committed
103
         (obj (make-instance class)))
pfdietz's avatar
pfdietz committed
104 105 106 107
    (setf (class-name class) nil)
    (notnot-mv (typep obj class)))
  t)

108 109
(deftest type-of.11
  (let* ((c #c(-1 1/2))
sds's avatar
sds committed
110
         (type (type-of c)))
111 112 113
    (notnot (typep c type)))
  t)

114 115 116
;;; Error tests

(deftest type-of.error.1
117 118
  (signals-error (type-of) program-error)
  t)
119 120

(deftest type-of.error.2
121
  (signals-error (type-of nil nil) program-error)
sds's avatar
sds committed
122
  t)
pfdietz's avatar
pfdietz committed
123