tests/type.before-xc.lisp

   1 ;;;; tests of the type system, intended to be executed as soon as
   2 ;;;; the cross-compiler is built
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; While most of SBCL is derived from the CMU CL system, the test
   8 ;;;; files (like this one) were written from scratch after the fork
   9 ;;;; from CMU CL.
  10 ;;;;
  11 ;;;; This software is in the public domain and is provided with
  12 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  13 ;;;; more information.
  14
  15 (unless (find-package "BEFORE-XC-TESTS")
  16   (make-package "BEFORE-XC-TESTS" :use '("SB-XC" "SB-KERNEL" "SB-INT")))
  17 (do-external-symbols (s "SB-XC") ; Import all symbols from SB-XC, then use CL
  18   (shadowing-import s "BEFORE-XC-TESTS"))
  19 (import '(sb-kernel::type-union2) "BEFORE-XC-TESTS")
  20 (cl:use-package '("COMMON-LISP") "BEFORE-XC-TESTS")
  21
  22 (in-package "BEFORE-XC-TESTS")
  23
  24 ;;; Assert that some of the type specifiers which we claim have unique internal
  25 ;;; representations do, and that parsing does not rely critically on
  26 ;;; memoization performed in SPECIFIER-TYPE, which is only a best effort
  27 ;;; to produce the EQ model object given an EQUAL specifier.
  28 (dolist (type sb-kernel::*special-union-types*)
  29   (dolist (constituent-type (union-type-types (specifier-type type)))
  30     (let ((specifier (type-specifier constituent-type)))
  31       (drop-all-hash-caches)
  32       (let ((parse (specifier-type specifier)))
  33         (drop-all-hash-caches)
  34         (let ((reparse (specifier-type specifier)))
  35           (aver (eq parse reparse)))))))
  36
  37 (assert (type= (specifier-type '(and fixnum (satisfies foo)))
  38                (specifier-type '(and (satisfies foo) fixnum))))
  39 (assert (type= (specifier-type '(member 1 2 3))
  40                (specifier-type '(member 2 3 1))))
  41 (assert (type= (specifier-type '(and (member 1.0 2 3) single-float))
  42                (specifier-type '(member 1.0))))
  43
  44 (assert (typep "hello" '(and array (not (array t)))))
  45 (assert (typep "hello" 'string))
  46 (assert (typep "hello" 'simple-string))
  47 (assert (typep "hello" 'unboxed-array))
  48 (assert (typep "hello" 'simple-unboxed-array))
  49
  50 (assert (typep #*101 '(and array (not (array t)))))
  51 (assert (typep #*101 'bit-vector))
  52 (assert (typep #*101 'simple-bit-vector))
  53 (assert (typep #*101 'unboxed-array))
  54 (assert (typep #*101 'simple-unboxed-array))
  55
  56 ;;; When the host does not have (UNSIGNED-BYTE n), this makes an excellent test.
  57 ;;; When the host *does* have it, this test is "suspicious" (in the sense that
  58 ;;; it would not necessarily detect a bug in our portable array logic),
  59 ;;; but is nonetheless valid, and especially since most other lisps don't
  60 ;;; have (UNSIGNED-BYTE 2), it's a pretty reasonable thing to check.
  61 (dovector (x sb-vm:*specialized-array-element-type-properties*)
  62   (let ((et (sb-vm:saetp-specifier x)))
  63     ;; Test the numeric array specializations.
  64     (unless (member et '(nil t base-char character))
  65       (let ((a (make-array 11 :element-type et)))
  66         (assert (type= (ctype-of a) (specifier-type `(simple-array ,et (11)))))
  67         (assert (typep a '(and array (not (array t)))))
  68         (assert (typep a `(simple-array ,et (11))))
  69         (assert (typep a `(array ,et (11))))
  70         (dolist (type-atom '(unboxed-array simple-unboxed-array))
  71           (assert (typep a type-atom))
  72           (assert (typep a `(,type-atom *)))
  73           (assert (typep a `(,type-atom (*))))
  74           (assert (typep a `(,type-atom (11)))))))))
  75
  76 ;;; Here it doesn't matter what we specify as element-type to MAKE-ARRAY
  77 ;;; because it introspects as if it were SIMPLE-VECTOR due to
  78 ;;; non-use of make-specialized-array.
  79 ;;; (Note use of CL:MAKE-ARRAY. This file of tests causes symbol lookup
  80 ;;; to default to using the SB-XC symbol otherwise)
  81 (assert (type= (ctype-of (cl:make-array 11 :element-type '(signed-byte 8)))
  82                (specifier-type '(simple-vector 11))))
  83
  84 (assert (typep #(1 2 3) 'simple-vector))
  85 (assert (typep #(1 2 3) 'vector))
  86 (assert (not (typep '(1 2 3) 'vector)))
  87 (assert (not (typep 1 'vector)))
  88
  89 (assert (typep '(1 2 3) 'list))
  90 (assert (typep '(1 2 3) 'cons))
  91 (assert (not (typep '(1 2 3) 'null)))
  92 (assert (not (typep "1 2 3" 'list)))
  93 (assert (not (typep 1 'list)))
  94
  95 (assert (typep nil 'null))
  96 (assert (typep nil '(member nil)))
  97 (assert (typep nil '(member 1 2 nil 3)))
  98 (assert (not (typep nil '(member 1 2 3))))
  99
 100 (assert (type= *empty-type*
 101                (type-intersection (specifier-type 'list)
 102                                   (specifier-type 'vector))))
 103 (assert (type= *empty-type*
 104                (type-intersection (specifier-type 'list)
 105                                   (specifier-type 'vector))))
 106 (assert (type= (specifier-type 'null)
 107                (type-intersection (specifier-type 'list)
 108                                   (specifier-type '(or vector null)))))
 109 (assert (type= (specifier-type 'null)
 110                (type-intersection (specifier-type 'sequence)
 111                                   (specifier-type 'symbol))))
 112 (assert (type= (specifier-type 'cons)
 113                (type-intersection (specifier-type 'sequence)
 114                                   (specifier-type '(or cons number)))))
 115 (assert (type= (specifier-type '(simple-array character (*)))
 116                (type-intersection (specifier-type 'sequence)
 117                                   (specifier-type '(simple-array character)))))
 118 (assert (type= (specifier-type 'list)
 119                (type-intersection (specifier-type 'sequence)
 120                                   (specifier-type 'list))))
 121 (assert (type= *empty-type*
 122                (type-intersection (specifier-type '(satisfies keywordp))
 123                                   *empty-type*)))
 124
 125 (assert (type= (specifier-type 'list)
 126                (type-union (specifier-type 'cons) (specifier-type 'null))))
 127 (assert (type= (specifier-type 'list)
 128                (type-union (specifier-type 'null) (specifier-type 'cons))))
 129 #+nil ; not any more
 130 (assert (type= (specifier-type 'sequence)
 131                (type-union (specifier-type 'list) (specifier-type 'vector))))
 132 #+nil ; not any more
 133 (assert (type= (specifier-type 'sequence)
 134                (type-union (specifier-type 'vector) (specifier-type 'list))))
 135 (assert (type= (specifier-type 'list)
 136                (type-union (specifier-type 'cons) (specifier-type 'list))))
 137 (let ((sb-kernel::*xtypep-uncertainty-action* nil))
 138   (assert (not (csubtypep (type-union (specifier-type 'list)
 139                                       (specifier-type '(satisfies foo)))
 140                           (specifier-type 'list))))
 141   (assert (csubtypep (specifier-type 'list)
 142                      (type-union (specifier-type 'list)
 143                                  (specifier-type '(satisfies foo))))))
 144
 145 ;;; Identities should be identities.
 146 (dolist (type-specifier '(nil
 147                           t
 148                           null
 149                           (satisfies keywordp)
 150                           (satisfies foo)
 151                           (not fixnum)
 152                           (not null)
 153                           (and symbol (satisfies foo))
 154                           (and (satisfies foo) string)
 155                           (or symbol sequence)
 156                           (or single-float character)
 157                           (or float (satisfies bar))
 158                           integer (integer 0 1)
 159                           character standard-char
 160                           (member 1 2 3)))
 161   (let ((ctype (specifier-type type-specifier)))
 162
 163     (assert (type= *empty-type* (type-intersection ctype *empty-type*)))
 164     (assert (type= *empty-type* (type-intersection *empty-type* ctype)))
 165     (assert (type= *empty-type* (type-intersection2 ctype *empty-type*)))
 166     (assert (type= *empty-type* (type-intersection2 *empty-type* ctype)))
 167
 168     (assert (type= ctype (type-intersection ctype *universal-type*)))
 169     (assert (type= ctype (type-intersection *universal-type* ctype)))
 170     (assert (type= ctype (type-intersection2 ctype *universal-type*)))
 171     (assert (type= ctype (type-intersection2 *universal-type* ctype)))
 172
 173     (assert (type= *universal-type* (type-union ctype *universal-type*)))
 174     (assert (type= *universal-type* (type-union *universal-type* ctype)))
 175     (assert (type= *universal-type* (type-union2 ctype *universal-type*)))
 176     (assert (type= *universal-type* (type-union2 *universal-type* ctype)))
 177
 178     (assert (type= ctype (type-union ctype *empty-type*)))
 179     (assert (type= ctype (type-union *empty-type* ctype)))
 180     (assert (type= ctype (type-union2 ctype *empty-type*)))
 181     (assert (type= ctype (type-union2 *empty-type* ctype)))
 182
 183     (assert (csubtypep *empty-type* ctype))
 184     (assert (csubtypep ctype *universal-type*))))
 185
 186 (assert (subtypep 'simple-vector 'vector))
 187 (assert (subtypep 'simple-vector 'simple-array))
 188 (assert (subtypep 'vector 'array))
 189 (assert (not (subtypep 'vector 'simple-vector)))
 190 (assert (not (subtypep 'vector 'simple-array)))
 191
 192 (macrolet ((assert-secondnil (expr) `(assert (null (nth-value 1 ,expr)))))
 193   (assert-secondnil (subtypep t '(satisfies foo)))
 194   (assert-secondnil (subtypep t '(and (satisfies foo) (satisfies bar))))
 195   (assert-secondnil (subtypep t '(or (satisfies foo) (satisfies bar))))
 196   (assert-secondnil (subtypep '(satisfies foo) nil))
 197   (assert-secondnil (subtypep '(and (satisfies foo) (satisfies bar))
 198                                     nil))
 199   (assert-secondnil (subtypep '(or (satisfies foo) (satisfies bar))
 200                                     nil)))
 201
 202 ;;; tests of 2-value quantifieroids FOO/TYPE
 203 (macrolet ((2= (v1 v2 expr2)
 204              (let ((x1 (gensym))
 205                    (x2 (gensym)))
 206                `(multiple-value-bind (,x1 ,x2) ,expr2
 207                   (unless (and (eql ,x1 ,v1) (eql ,x2 ,v2))
 208                     (error "mismatch for EXPR2=~S" ',expr2))))))
 209   (flet (;; SUBTYPEP running in the cross-compiler
 210          (xsubtypep (x y)
 211            (csubtypep (specifier-type x)
 212                       (specifier-type y))))
 213     (2=   t   t (any/type   #'xsubtypep 'fixnum '(real integer)))
 214     (2=   t   t (any/type   #'xsubtypep 'fixnum '(real cons)))
 215     (2= nil   t (any/type   #'xsubtypep 'fixnum '(cons vector)))
 216     (2= nil nil (any/type   #'xsubtypep 'fixnum '(cons some-unknown-type-foo)))
 217     (2= nil nil (any/type   #'xsubtypep 'fixnum '(some-unknown-type-foo cons)))
 218     (2=   t   t (any/type   #'xsubtypep 'fixnum '(some-unknown-type-foo real)))
 219     (2=   t   t (any/type   #'xsubtypep 'fixnum '(real some-unknown-type-foo)))
 220     (2= nil   t (any/type   #'xsubtypep 'fixnum '()))
 221     (2=   t   t (every/type #'xsubtypep 'fixnum '()))
 222     (2= nil nil (every/type #'xsubtypep 'fixnum '(real some-unknown-type-foo)))
 223     (2= nil nil (every/type #'xsubtypep 'fixnum '(some-unknown-type-foo real)))
 224     (2= nil   t (every/type #'xsubtypep 'fixnum '(some-unknown-type-foo cons)))
 225     (2= nil   t (every/type #'xsubtypep 'fixnum '(cons some-unknown-type-foo)))
 226     (2=   t   t (every/type #'xsubtypep 'fixnum '(real integer)))
 227     (2= nil   t (every/type #'xsubtypep 'fixnum '(real cons)))
 228     (2= nil   t (every/type #'xsubtypep 'fixnum '(cons vector)))))
 229
 230 ;;; various dead bugs
 231 (assert (union-type-p (type-intersection (specifier-type 'list)
 232                                          (specifier-type '(or list vector)))))
 233 (assert (type= (type-intersection (specifier-type 'list)
 234                                   (specifier-type '(or list vector)))
 235                (specifier-type 'list)))
 236 (assert (array-type-p (type-intersection (specifier-type 'vector)
 237                                          (specifier-type '(or list vector)))))
 238 (assert (type= (type-intersection (specifier-type 'vector)
 239                                   (specifier-type '(or list vector)))
 240                (specifier-type 'vector)))
 241 (assert (type= (type-intersection (specifier-type 'number)
 242                                   (specifier-type 'integer))
 243                (specifier-type 'integer)))
 244 (let ((sb-kernel::*xtypep-uncertainty-action* nil))
 245   (assert (null (type-intersection2 (specifier-type 'symbol)
 246                                     (specifier-type '(satisfies foo)))))
 247   (assert (intersection-type-p (specifier-type '(and symbol (satisfies foo))))))
 248 (assert (ctypep :x86 (specifier-type '(satisfies keywordp))))
 249 (assert (not (ctypep 'cons (specifier-type '(satisfies keywordp)))))
 250 (assert (type= (specifier-type '(member :x86))
 251                (specifier-type '(and (member :x86) (satisfies keywordp)))))
 252 #+nil
 253 (let* ((type1 (specifier-type '(member :x86)))
 254        (type2 (specifier-type '(or keyword null)))
 255        (isect (type-intersection type1 type2)))
 256   (assert (type= isect type1))
 257   (assert (type= isect (type-intersection type2 type1)))
 258   (assert (type= isect (type-intersection type2 type1 type2)))
 259   (assert (type= isect (type-intersection type1 type1 type2 type1)))
 260   (assert (type= isect (type-intersection type1 type2 type1 type2))))
 261 (let* ((type1 (specifier-type 'keyword))
 262        (type2 (specifier-type '(or keyword null)))
 263        (isect (type-intersection type1 type2)))
 264   (assert (type= isect type1))
 265   (assert (type= isect (type-intersection type2 type1)))
 266   (assert (type= isect (type-intersection type2 type1 type2)))
 267   (assert (type= isect (type-intersection type1 type1 type2 type1)))
 268   (assert (type= isect (type-intersection type1 type2 type1 type2))))
 269 (assert (csubtypep (specifier-type '(or (single-float -1.0 1.0)
 270                                         (single-float 0.1)))
 271                    (specifier-type '(or (real -1 7)
 272                                         (single-float 0.1)
 273                                         (single-float -1.0 1.0)))))
 274 (assert (not (csubtypep (specifier-type '(or (real -1 7)
 275                                              (single-float 0.1)
 276                                              (single-float -1.0 1.0)))
 277                         (specifier-type '(or (single-float -1.0 1.0)
 278                                              (single-float 0.1))))))
 279
 280 (assert (typep #\, 'character))
 281 (assert (typep #\@ 'character))
 282
 283 (assert (type= (type-intersection (specifier-type '(member #\a #\c #\e))
 284                                  (specifier-type '(member #\b #\c #\f)))
 285               (specifier-type '(member #\c))))
 286
 287 (multiple-value-bind (yes win)
 288     (subtypep 'package 'instance)
 289   (assert yes)
 290   (assert win))
 291 (multiple-value-bind (yes win)
 292     (subtypep 'symbol 'instance)
 293   (assert (not yes))
 294   (assert win))
 295 (multiple-value-bind (yes win)
 296     (subtypep 'package 'funcallable-instance)
 297   (assert (not yes))
 298   (assert win))
 299 (multiple-value-bind (yes win)
 300     (subtypep 'symbol 'funcallable-instance)
 301   (assert (not yes))
 302   (assert win))
 303 (multiple-value-bind (yes win)
 304     (subtypep 'funcallable-instance 'function)
 305   (assert yes)
 306   (assert win))
 307 (multiple-value-bind (yes win)
 308     (subtypep 'array 'instance)
 309   (assert (not yes))
 310   (assert win))
 311 (multiple-value-bind (yes win)
 312     (subtypep 'character 'instance)
 313   (assert (not yes))
 314   (assert win))
 315 (multiple-value-bind (yes win)
 316     (subtypep 'number 'instance)
 317   (assert (not yes))
 318   (assert win))
 319 (multiple-value-bind (yes win)
 320     (subtypep 'package '(and (or symbol package) instance))
 321   (assert yes)
 322   (assert win))
 323 (multiple-value-bind (yes win)
 324     (subtypep '(and (or double-float integer) instance) 'nil)
 325   (assert yes)
 326   (assert win))
 327 (multiple-value-bind (yes win)
 328     (subtypep '(and (or double-float integer) funcallable-instance) 'nil)
 329   (assert yes)
 330   (assert win))
 331 (multiple-value-bind (yes win) (subtypep 'instance 'type-specifier)
 332   (assert (not yes))
 333   (assert (not win)))
 334 (multiple-value-bind (yes win) (subtypep 'type-specifier 'instance)
 335   (assert (not yes))
 336   (assert win))
 337 (multiple-value-bind (yes win) (subtypep 'class 'type-specifier)
 338   (assert yes)
 339   (assert win))
 340 (multiple-value-bind (yes win) (subtypep 'classoid 'type-specifier)
 341   (assert yes)
 342   (assert win))
 343 (multiple-value-bind (yes win)
 344     (subtypep '(and (function (t)) funcallable-instance) 'nil)
 345   (assert (not win))
 346   (assert (not yes)))
 347 (multiple-value-bind (yes win)
 348     (subtypep '(and fixnum function) 'nil)
 349   (assert yes)
 350   (assert win))
 351 (multiple-value-bind (yes win)
 352     (subtypep '(and fixnum hash-table) 'nil)
 353   (assert yes)
 354   (assert win))
 355 (multiple-value-bind (yes win)
 356     (subtypep '(function) '(function (t &rest t)))
 357   (assert (not yes))
 358   (assert win))
 359 ;; Used to run out of stack.
 360 (let ((sb-kernel::*xtypep-uncertainty-action* nil))
 361   (multiple-value-bind (yes win)
 362       (handler-bind ((sb-kernel::cross-type-giving-up #'muffle-warning))
 363         (subtypep 'null '(or unk0 unk1)))
 364     (assert (not yes))
 365     (assert (not win))))
 366
 367 (multiple-value-bind (yes win)
 368     (subtypep '(and function instance) nil)
 369   (assert yes)
 370   (assert win))
 371 (multiple-value-bind (yes win)
 372     (subtypep nil '(and function instance))
 373   (assert yes)
 374   (assert win))
 375 (multiple-value-bind (yes win)
 376     (subtypep '(and function funcallable-instance) 'funcallable-instance)
 377   (assert yes)
 378   (assert win))
 379 (multiple-value-bind (yes win)
 380     (subtypep 'funcallable-instance '(and function funcallable-instance))
 381   (assert yes)
 382   (assert win))
 383 (multiple-value-bind (yes win)
 384     (subtypep 'stream 'instance)
 385   (assert (not win))
 386   (assert (not yes)))
 387 (multiple-value-bind (yes win)
 388     (subtypep 'stream 'funcallable-instance)
 389   (assert (not yes))
 390   (assert win))
 391 (multiple-value-bind (yes win)
 392     (subtypep '(and stream instance) 'instance)
 393   (assert yes)
 394   (assert win))
 395 (multiple-value-bind (yes win)
 396     (subtypep '(and stream funcallable-instance) 'funcallable-instance)
 397   (assert yes)
 398   (assert win))
 399 (multiple-value-bind (yes win)
 400     (subtypep '(and stream instance) 'stream)
 401   (assert yes)
 402   (assert win))
 403 (multiple-value-bind (yes win)
 404     (subtypep '(and stream funcallable-instance) 'stream)
 405   (assert yes)
 406   (assert win))
 407
 408 (assert (type= (specifier-type 'nil)
 409                (specifier-type '(and symbol funcallable-instance))))
 410
 411 (assert (not (type= (specifier-type '(function (t) (values &optional)))
 412                     (specifier-type '(function (t) (values))))))
 413
 414 ;; Assert that these types are interned by parsing each twice,
 415 ;; dropping the specifier-type cache in between.
 416 (dolist (spec '(index cons null boolean character base-char extended-char))
 417   (let ((a (specifier-type spec)))
 418     (drop-all-hash-caches)
 419     (let ((b (specifier-type spec)))
 420       (assert (eq a b)))))
 421 (drop-all-hash-caches)
 422 ;; BOOLEAN's deftype lists the members as (T NIL),
 423 ;; but it should also be EQ to (MEMBER NIL T)
 424 (assert (eq (specifier-type '(member nil t)) (specifier-type 'boolean)))
 425
 426 #+x86-64
 427 (progn
 428   (assert (= (sb-vm::immediate-constant-sc #c(0.0f0 0.0f0))
 429              sb-vm::fp-complex-single-zero-sc-number))
 430   (assert (= (sb-vm::immediate-constant-sc #c(0.0d0 0.0d0))
 431              sb-vm::fp-complex-double-zero-sc-number)))
 432
 433 ;;; Unparse a union of (up to) 3 things depending on :sb-unicode as 2 things.
 434 (assert (sb-kernel::brute-force-type-specifier-equalp
 435          (type-specifier (specifier-type '(or string null)))
 436          '(or #+sb-unicode string #-sb-unicode base-string null)))
 437
 438 (multiple-value-bind (result exactp)
 439     (sb-vm::primitive-type (specifier-type 'list))
 440   (assert (and (eq result (sb-vm::primitive-type-or-lose 'list))
 441                exactp)))
 442 (multiple-value-bind (result exactp)
 443     (sb-vm::primitive-type (specifier-type 'cons))
 444   (assert (and (eq result (sb-vm::primitive-type-or-lose 'list))
 445                (not exactp))))
 446
 447 (let ((bs (specifier-type 'base-string))
 448       (not-sbs (specifier-type '(not simple-base-string)))
 449       (not-ss (specifier-type '(not simple-string))))
 450   (let ((intersect (type-intersection bs not-sbs)))
 451     (assert (array-type-p intersect))
 452     (assert (type= intersect (specifier-type '(and base-string (not simple-array))))))
 453   ;; should be commutative
 454   (let ((intersect (type-intersection not-sbs bs)))
 455     (assert (array-type-p intersect))
 456     (assert (type= intersect (specifier-type '(and base-string (not simple-array))))))
 457   ;; test when the righthand side is a larger negation type
 458   (let ((intersect (type-intersection bs not-ss)))
 459     (assert (array-type-p intersect))
 460     (assert (type= intersect (specifier-type '(and base-string (not simple-array))))))
 461   (let ((intersect (type-intersection not-sbs bs)))
 462     (assert (array-type-p intersect))
 463     (assert (type= intersect (specifier-type '(and base-string (not simple-array)))))))
 464
 465 #+sb-unicode
 466 (let ((cs (specifier-type 'sb-kernel::character-string))
 467       (not-scs (specifier-type '(not sb-kernel:simple-character-string)))
 468       (not-ss (specifier-type '(not simple-string))))
 469   (let ((intersect (type-intersection cs not-scs)))
 470     (assert (array-type-p intersect))
 471     (assert (type= intersect (specifier-type '(and sb-kernel::character-string (not simple-array))))))
 472   (let ((intersect (type-intersection not-scs cs)))
 473     (assert (array-type-p intersect))
 474     (assert (type= intersect (specifier-type '(and sb-kernel::character-string (not simple-array))))))
 475   ;; test when the righthand side is a larger negation type
 476   (let ((intersect (type-intersection cs not-ss)))
 477     (assert (array-type-p intersect))
 478     (assert (type= intersect (specifier-type '(and sb-kernel::character-string (not simple-array))))))
 479   (let ((intersect (type-intersection not-ss cs)))
 480     (assert (array-type-p intersect))
 481     (assert (type= intersect (specifier-type '(and sb-kernel::character-string (not simple-array)))))))
 482
 483 #+sb-unicode
 484 (let ((s (specifier-type 'string))
 485       (not-ss (specifier-type '(not simple-string))))
 486   (let ((intersect (type-intersection s not-ss)))
 487     (assert (union-type-p intersect))
 488     (assert (type= intersect (specifier-type '(and string (not simple-array))))))
 489   (let ((intersect (type-intersection not-ss s)))
 490     (assert (union-type-p intersect))
 491     (assert (type= intersect (specifier-type '(and string (not simple-array)))))))
 492
 493 (let ((left (specifier-type '(array bit (2 2))))
 494       (right (specifier-type '(not (simple-array bit)))))
 495   (let ((intersect (type-intersection left right)))
 496     (assert (array-type-p intersect))
 497     (assert (type= intersect (specifier-type
 498                               '(and (array bit (2 2))
 499                                     (not simple-array)))))))
 500
 501 ;;; The instance-typep transform shouldn't need two different lowtag tests
 502 ;;; on instance types other than [funcallable-]standard-object.
 503 ;;; And for some reason we suppose that STREAM may be either funcallable or not.
 504 (dolist (type '(pathname logical-pathname condition))
 505   (multiple-value-bind (answer certain)
 506       (csubtypep (find-classoid type) (specifier-type 'funcallable-instance))
 507     (assert (and (not answer) certain)))
 508   (aver (csubtypep (find-classoid type) (specifier-type 'instance))))
 509
 510 (assert (sb-int:list-elts-eq '(a b 1) '(a b 1)))
 511 (assert (not (sb-int:list-elts-eq '(foo) '(foo bar))))
 512 (assert (not (sb-int:list-elts-eq '(foo bar) '(foo))))
 513
 514 (assert (sb-int:list-elements-eql '(a b 1) '(a b 1)))
 515 (assert (sb-int:list-elements-eql '(1.0d0 x y) '(1.0d0 x y)))
 516 (assert (not (sb-int:list-elements-eql '(foo) '(foo bar))))
 517 (assert (not (sb-int:list-elements-eql '(foo bar) '(foo))))
 518
 519 ;;; I frankly have no idea whether we really care about the enumerable bit any more,
 520 ;;; because while what it's supposed to mean is "could _this_ type which is not a MEMBER
 521 ;;; type be internally represented as a MEMBER type?" Wwhat makes it questionable
 522 ;;; is that we seldom or never represent numerics as MEMBER. I do not know if this is a
 523 ;;; relic of days long past.
 524 (assert (sb-kernel::type-enumerable
 525          (sb-kernel:specifier-type '(and integer (integer 1 5)))))
 526 (assert (sb-kernel::type-enumerable
 527          (sb-kernel:specifier-type '(single-float 1.0 1.0))))