defclass-forward-reference.lsp 4.54 KB
Newer Older
1 2 3 4 5 6 7 8 9
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Apr  2 22:53:27 2003
;;;; Contains: Tests for definitions of classes with forward references

(in-package :cl-test)

(deftest defclass.forward-ref.1
  (let ((c1 (gensym))
sds's avatar
sds committed
10
        (c2 (gensym)))
11 12
    (let ((class1 (eval `(defclass ,c1 (,c2) nil))))
      (if (not (typep class1 'class))
sds's avatar
sds committed
13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
          1
        (let ((class2 (eval `(defclass ,c2 nil nil))))
          (if (not (typep class2 'class))
              2
            (let ((i1 (make-instance c1))
                  (i2 (make-instance c2)))
              (cond
               ((not (typep i1 c1))     3)
               ((not (typep i1 class1)) 4)
               ((not (typep i1 c2))     5)
               ((not (typep i1 class2)) 6)
               ((typep i2 c1)           7)
               ((typep i2 class1)       8)
               ((not (typep i2 c2))     9)
               ((not (typep i2 class2)) 10)
               (t 'good))))))))
29 30 31 32
  good)

(deftest defclass.forward-ref.2
  (let ((c1 (gensym))
sds's avatar
sds committed
33 34
        (c2 (gensym))
        (c3 (gensym)))
35 36
    (let ((class1 (eval `(defclass ,c1 (,c2 ,c3) nil))))
      (if (not (typep class1 'class))
sds's avatar
sds committed
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
          1
        (let ((class2 (eval `(defclass ,c2 nil nil))))
          (if (not (typep class2 'class))
              2
            (let ((class3 (eval `(defclass ,c3 nil nil))))
              (if (not (typep class3 'class))
                  3
                (let ((i1 (make-instance c1))
                      (i2 (make-instance c2))
                      (i3 (make-instance c3)))
                  (cond
                   ((not (typep i1 c1))     4)
                   ((not (typep i1 class1)) 5)
                   ((not (typep i1 c2))     6)
                   ((not (typep i1 class2)) 7)
                   ((not (typep i1 c3))     8)
                   ((not (typep i1 class3)) 9)
                   ((typep i2 c1)           10)
                   ((typep i2 class1)       11)
                   ((typep i3 c1)           12)
                   ((typep i3 class1)       13)
                   ((not (typep i2 c2))     14)
                   ((not (typep i2 class2)) 15)
                   ((not (typep i3 c3))     16)
                   ((not (typep i3 class3)) 17)
                   ((typep i2 c3)           18)
                   ((typep i2 class3)       19)
                   ((typep i3 c2)           20)
                   ((typep i3 class2)       21)
                   (t 'good))))))))))
67 68 69 70
  good)

(deftest defclass.forward-ref.3
  (let ((c1 (gensym))
sds's avatar
sds committed
71 72
        (c2 (gensym))
        (c3 (gensym)))
73 74
    (let ((class1 (eval `(defclass ,c1 (,c2) nil))))
      (if (not (typep class1 'class))
sds's avatar
sds committed
75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
          1
        (let ((class2 (eval `(defclass ,c2 (,c3) nil))))
          (if (not (typep class2 'class))
              2
            (let ((class3 (eval `(defclass ,c3 nil nil))))
              (if (not (typep class3 'class))
                  3
                (let ((i1 (make-instance c1))
                      (i2 (make-instance c2))
                      (i3 (make-instance c3)))
                  (cond
                   ((not (typep i1 c1))     4)
                   ((not (typep i1 class1)) 5)
                   ((not (typep i1 c2))     6)
                   ((not (typep i1 class2)) 7)
                   ((not (typep i1 c3))     8)
                   ((not (typep i1 class3)) 9)
                   ((typep i2 c1)           10)
                   ((typep i2 class1)       11)
                   ((typep i3 c1)           12)
                   ((typep i3 class1)       13)
                   ((not (typep i2 c2))     14)
                   ((not (typep i2 class2)) 15)
                   ((not (typep i3 c3))     16)
                   ((not (typep i3 class3)) 17)
                   ((not (typep i2 c3))     18)
                   ((not (typep i2 class3)) 19)
                   ((typep i3 c2)           20)
                   ((typep i3 class2)       21)
                   (t 'good))))))))))
105 106
  good)

107 108 109
(deftest defclass.forward-ref.4
  (block nil
    (let ((c1 (gensym))
sds's avatar
sds committed
110 111 112 113
          (c2 (gensym))
          (c3 (gensym))
          (c4 (gensym))
          (c5 (gensym)))
114
      (unless (typep (eval `(defclass ,c4 nil nil)) 'class)
sds's avatar
sds committed
115
        (return 1))
116
      (unless (typep (eval `(defclass ,c5 nil nil)) 'class)
sds's avatar
sds committed
117
        (return 2))
118
      (unless (typep (eval `(defclass ,c1 (,c2 ,c3) nil)) 'class)
sds's avatar
sds committed
119
        (return 3))
120
      (unless (typep (eval `(defclass ,c2 (,c4 ,c5) nil)) 'class)
sds's avatar
sds committed
121
        (return 4))
122 123
      (handler-case
       (eval `(progn
sds's avatar
sds committed
124 125
                (defclass ,c3 (,c5 ,c4) nil)
                (make-instance ',c1)))
126 127
       (error () :good))))
  :good)