tests/type.impure.lisp

   1 (in-package :cl-user)
   2
   3 (load "assertoid.lisp")
   4
   5 (defmacro assert-nil-nil (expr)
   6   `(assert (equal '(nil nil) (multiple-value-list ,expr))))
   7 (defmacro assert-nil-t (expr)
   8   `(assert (equal '(nil t) (multiple-value-list ,expr))))
   9 (defmacro assert-t-t (expr)
  10   `(assert (equal '(t t) (multiple-value-list ,expr))))
  11
  12 (let ((types '(character
  13                integer fixnum (integer 0 10)
  14                single-float (single-float -1.0 1.0) (single-float 0.1)
  15                (real 4 8) (real -1 7) (real 2 11)
  16                (member #\a #\b #\c) (member 1 #\a) (member 3.0 3.3))))
  17   (dolist (i types)
  18     (format t "type I=~S~%" i)
  19     (dolist (j types)
  20       (format t "  type J=~S~%" j)
  21       (assert (subtypep i `(or ,i ,j)))
  22       (assert (subtypep i `(or ,j ,i)))
  23       (assert (subtypep i `(or ,i ,i ,j)))
  24       (assert (subtypep i `(or ,j ,i)))
  25       (dolist (k types)
  26         (format t "    type K=~S~%" k)
  27         (assert (subtypep `(or ,i ,j) `(or ,i ,j ,k)))
  28         ;; FIXME: The old code (including original CMU CL code)
  29         ;; fails this test. When this is fixed, we can re-enable it.
  30         #+nil (assert (subtypep `(or ,i ,j) `(or ,k ,j ,i)))))))
  31
  32 ;;; gotchas that can come up in handling subtypeness as "X is a
  33 ;;; subtype of Y if each of the elements of X is a subtype of Y"
  34 #+nil ; FIXME: suppressed until we can fix old CMU CL big
  35 (let ((subtypep-values (multiple-value-list
  36                         (subtypep '(single-float -1.0 1.0)
  37                                   '(or (real -100.0 0.0)
  38                                        (single-float 0.0 100.0))))))
  39   (assert (member subtypep-values
  40                   '(;; The system isn't expected to
  41                     ;; understand the subtype relationship.
  42                     (nil nil)
  43                     ;; But if it does, that'd be neat.
  44                     (t t)
  45                     ;; (And any other return would be wrong.)
  46                     ))))
  47
  48 (defun type-evidently-= (x y)
  49   (and (subtypep x y)
  50        (subtypep y x)))
  51
  52 (assert (subtypep 'single-float 'float))
  53
  54 (assert (type-evidently-= '(integer 0 10) '(or (integer 0 5) (integer 4 10))))
  55
  56 ;;; sbcl-0.6.10 did (UPGRADED-ARRAY-ELEMENT-TYPE 'SOME-UNDEF-TYPE)=>T
  57 ;;; and (UPGRADED-COMPLEX-PART-TYPE 'SOME-UNDEF-TYPE)=>T.
  58 (assert (raises-error? (upgraded-array-element-type 'some-undef-type)))
  59 (assert (eql (upgraded-array-element-type t) t))
  60 (assert (raises-error? (upgraded-complex-part-type 'some-undef-type)))
  61 (assert (subtypep (upgraded-complex-part-type 'fixnum) 'real))
  62
  63 ;;; Do reasonable things with undefined types, and with compound types
  64 ;;; built from undefined types.
  65 ;;;
  66 ;;; part I: TYPEP
  67 (assert (typep #(11) '(simple-array t 1)))
  68 (assert (typep #(11) '(simple-array (or integer symbol) 1)))
  69 (assert (raises-error? (typep #(11) '(simple-array undef-type 1))))
  70 (assert (not (typep 11 '(simple-array undef-type 1))))
  71 ;;; part II: SUBTYPEP
  72 (assert (subtypep '(vector some-undef-type) 'vector))
  73 (assert (not (subtypep '(vector some-undef-type) 'integer)))
  74 (assert-nil-nil (subtypep 'utype-1 'utype-2))
  75 (assert-nil-nil (subtypep '(vector utype-1) '(vector utype-2)))
  76 (assert-nil-nil (subtypep '(vector utype-1) '(vector t)))
  77 (assert-nil-nil (subtypep '(vector t) '(vector utype-2)))
  78
  79 ;;; ANSI specifically disallows bare AND and OR symbols as type specs.
  80 #| ; Alas, this is part of bug 10, still unfixed as of sbcl-0.6.11.10.
  81 (assert (raises-error? (typep 11 'and)))
  82 (assert (raises-error? (typep 11 'or)))
  83 |#
  84 ;;; Of course empty lists of subtypes are still OK.
  85 (assert (typep 11 '(and)))
  86 (assert (not (typep 11 '(or))))
  87
  88 ;;; success
  89 (quit :unix-status 104)