subtypep-member.lsp 5.5 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Feb 15 11:58:06 2003
;;;; Contains: Tests for subtype relationships on member types

(in-package :cl-test)

8

9

10 11 12
;;; SUBTYPEP on MEMBER types

(deftest subtypep.member.1
13 14
  (check-all-subtypep '(member a b c) '(member a b c d))
  nil)
15 16

(deftest subtypep.member.2
17 18
  (check-all-not-subtypep '(member a b c) '(member a b))
  nil)
19 20 21 22 23 24

(deftest subtypep.member.3
  (check-equivalence '(member) nil)
  nil)

(deftest subtypep.member.4
25 26
  (check-all-subtypep '(eql b) '(member a b c))
  nil)
27 28

(deftest subtypep.member.5
29 30
  (check-all-subtypep '(member a b c d e) 'symbol)
  nil)
31 32

(deftest subtypep.member.6
33 34
  (check-all-not-subtypep '(member a b 10 d e) 'symbol)
  nil)
35 36

(deftest subtypep.member.7
37 38
  (check-all-subtypep 'null '(member a b nil c d e))
  nil)
39 40

(deftest subtypep.member.8
41 42
  (check-all-not-subtypep 'null '(member a b c d e))
  nil)
43 44 45

(deftest subtypep.member.9
  (let ((b1 (1+ most-positive-fixnum))
sds's avatar
sds committed
46
        (b2 (1+ most-positive-fixnum)))
47 48
    (check-all-subtypep `(member 10 ,b1 20) `(member 10 20 ,b2)))
  nil)
49 50

(deftest subtypep.member.10
51 52
  (check-all-subtypep '(member :a :b :c) 'keyword)
  nil)
53 54 55

(deftest subtypep.member.11
  (let ((b1 (copy-list '(a)))
sds's avatar
sds committed
56
        (b2 (copy-list '(a))))
57 58
    (check-all-not-subtypep `(member 10 ,b1 20) `(member 10 20 ,b2)))
  nil)
59 60 61

(deftest subtypep.member.12
  (let ((b1 '(a)))
62 63
    (check-all-subtypep `(member 10 ,b1 20) `(member 10 20 ,b1)))
  nil)
64 65

(deftest subtypep.member.13
66 67
  (check-all-subtypep '(member 10 20 30) '(integer 0 100))
  nil)
68 69

(deftest subtypep.member.14
70 71
  (check-all-subtypep '(integer 3 6) '(member 0 1 2 3 4 5 6 7 8 100))
  nil)
72 73

(deftest subtypep.member.15
74 75
  (check-all-not-subtypep '(integer 3 6) '(member 0 1 2 3 5 6 7 8))
  nil)
76 77 78 79 80 81 82

(deftest subtypep.member.16
  (check-equivalence '(integer 2 5) '(member 2 5 4 3))
  nil)

(deftest subtypep.member.17
  (let ((s1 (copy-seq "abc"))
sds's avatar
sds committed
83
        (s2 (copy-seq "abc")))
84
    (let ((t1 `(member ,s1))
sds's avatar
sds committed
85
          (t2 `(member ,s2)))
86 87 88 89 90 91 92 93
      (cond
       ((subtypep t1 t2) "T1 is subtype of T2")
       ((subtypep t2 t1) "T2 is subtype of T1")
       (t (check-disjointness t1 t2)))))
  nil)

(deftest subtypep.member.18
  (let ((s1 (copy-seq '(a b c)))
sds's avatar
sds committed
94
        (s2 (copy-seq '(a b c))))
95
    (let ((t1 `(member ,s1))
sds's avatar
sds committed
96
          (t2 `(member ,s2)))
97 98 99 100 101 102 103 104
      (cond
       ((subtypep t1 t2) "T1 is subtype of T2")
       ((subtypep t2 t1) "T2 is subtype of T1")
       (t (check-disjointness t1 t2)))))
  nil)

(deftest subtypep.member.19
  (let ((i1 (1+ most-positive-fixnum))
sds's avatar
sds committed
105
        (i2 (1+ most-positive-fixnum)))
106 107 108 109 110
    (check-equivalence `(member 0 ,i1) `(member 0 ,i2)))
  nil)

(deftest subtypep.member.20
  (check-equivalence '(and (member a b c d) (member e d b f g))
sds's avatar
sds committed
111
                     '(member b d))
112 113 114 115
  nil)

(deftest subtypep.member.21
  (check-equivalence '(and (member a b c d) (member e d f g))
sds's avatar
sds committed
116
                     '(eql d))
117 118 119 120
  nil)

(deftest subtypep.member.22
  (check-equivalence '(and (member a b c d) (member e f g))
sds's avatar
sds committed
121
                     nil)
122 123 124 125
  nil)

(deftest subtypep.member.23
  (check-equivalence '(or (member a b c) (member z b w))
sds's avatar
sds committed
126
                     '(member z a b w c))
127 128 129 130
  nil)

(deftest subtypep.member.24
  (check-equivalence '(or (member a b c) (eql d))
sds's avatar
sds committed
131
                     '(member d c b a))
132 133 134 135 136 137 138 139
  nil)

(deftest subtypep.member.25
  (check-equivalence 'boolean '(member nil t))
  nil)

(deftest subtypep.member.26
  (check-equivalence '(or (eql a) (eql b))
sds's avatar
sds committed
140
                     '(member a b))
141 142
  nil)

143
(deftest subtypep.member.27
144
  (check-all-subtypep '(member a b c d) '(satisfies symbolp))
145 146 147 148 149 150 151
  nil)

(deftest subtypep.member.28
  (check-all-subtypep '(member a b c d) t)
  nil)

(deftest subtypep.member.29
152
  (check-all-not-subtypep '(member a b 10 z) '(satisfies symbolp))
153 154 155
  nil)

(deftest subtypep.member.30
156
  (check-disjointness '(member 1 6 10) '(satisfies symbolp))
157 158 159 160 161
  nil)

(deftest subtypep.member.31
  (check-equivalence '(member a b c d) '(member c d b a))
  nil)
162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178

(deftest subtypep.member.32
  (check-all-not-subtypep '(not (member a b 10 z)) '(satisfies symbolp))
  nil)

(deftest subtypep.member.33
  (check-all-not-subtypep  '(satisfies symbolp) '(member a b 10 z))
  nil)

(deftest subtypep.member.34
  (check-all-not-subtypep '(member a b 10 z) '(not (satisfies symbolp)))
  nil)

(deftest subtypep.member.35
  (check-all-not-subtypep  '(satisfies symbolp) '(member a b c d))
  nil)

179 180 181
(deftest subtypep.member.36
  (check-disjointness '(eql a) '(or (member b c d) (eql e)))
  nil)
182 183 184 185 186 187 188 189 190 191

(deftest subtypep.member.37
  (check-equivalence
   '(and (member a b c d) (not (eql c)))
   '(member a b d))
  nil)

(deftest subtypep.member.38
  (check-equivalence
   '(and (member a b c d e f g)
sds's avatar
sds committed
192
         (not (member b f)))
193 194 195 196 197 198
   '(member a c d e g))
  nil)

(deftest subtypep.member.39
  (check-equivalence
   '(and (not (member b d e f g))
sds's avatar
sds committed
199
         (not (member x y b z d)))
200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231
   '(not (member b d e f g x y z)))
  nil)

(deftest subtypep.member.40
  (check-equivalence
   '(and (not (eql a)) (not (eql b)))
   '(not (member a b)))
  nil)

(deftest subtypep.member.41
  (check-equivalence
   '(and (not (eql a)) (not (eql b)) (not (eql c)))
   '(not (member c b a)))
  nil)

(deftest subtypep.member.42
  (check-equivalence
   '(and (not (member a b)) (not (member b c)))
   '(not (member c b a)))
  nil)

(deftest subtypep.member.43
  (check-equivalence
   '(and (not (member a g b k e)) (not (member b h k c f)))
   '(not (member c b k a e f g h)))
  nil)

(deftest subtypep.member.44
  (check-equivalence
   '(and (integer 0 30) (not (member 3 4 5 9 10 11 17 18 19)))
   '(or (integer 0 2) (integer 6 8) (integer 12 16) (integer 20 30)))
  nil)