tests/type.pure.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; While most of SBCL is derived from the CMU CL system, the test
   5 ;;;; files (like this one) were written from scratch after the fork
   6 ;;;; from CMU CL.
   7 ;;;;
   8 ;;;; This software is in the public domain and is provided with
   9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  10 ;;;; more information.
  11
  12 (in-package "CL-USER")
  13
  14 (locally
  15   (declare (notinline mapcar))
  16   (mapcar (lambda (args)
  17             (destructuring-bind (obj type-spec result) args
  18               (flet ((matches-result? (x)
  19                        (eq (if x t nil) result)))
  20                 (assert (matches-result? (typep obj type-spec)))
  21                 (assert (matches-result? (sb-kernel:ctypep
  22                                           obj
  23                                           (sb-kernel:specifier-type
  24                                            type-spec)))))))
  25           '((nil (or null vector)              t)
  26             (nil (or number vector)            nil)
  27             (12  (or null vector)              nil)
  28             (12  (and (or number vector) real) t))))
  29
  30
  31 ;;; This test is motivated by bug #195, which previously had (THE REAL
  32 ;;; #(1 2 3)) give an error which prints as "This is not a (OR
  33 ;;; SINGLE-FLOAT DOUBLE-FLOAT RATIONAL)".  We ideally want all of the
  34 ;;; defined-by-ANSI types to unparse as themselves or at least
  35 ;;; something similar (e.g. CHARACTER can unparse to BASE-CHAR, since
  36 ;;; the types are equivalent in current SBCL, and EXTENDED-CHAR can
  37 ;;; unparse to NIL, since there are no EXTENDED-CHARs currently).
  38 (let ((standard-types '(;; from table 4-2 in section 4.2.3 in the
  39                         ;; CLHS.
  40                         arithmetic-error
  41                         function
  42                         simple-condition
  43                         array
  44                         generic-function
  45                         simple-error
  46                         atom
  47                         hash-table
  48                         simple-string
  49                         base-char
  50                         integer
  51                         simple-type-error
  52                         base-string
  53                         keyword
  54                         simple-vector
  55                         bignum
  56                         list
  57                         simple-warning
  58                         bit
  59                         logical-pathname
  60                         single-float
  61                         bit-vector
  62                         long-float
  63                         standard-char
  64                         broadcast-stream
  65                         method
  66                         standard-class
  67                         built-in-class
  68                         method-combination
  69                         standard-generic-function
  70                         cell-error
  71                         nil
  72                         standard-method
  73                         character
  74                         null
  75                         standard-object
  76                         class
  77                         number
  78                         storage-condition
  79                         compiled-function
  80                         package
  81                         stream
  82                         complex
  83                         package-error
  84                         stream-error
  85                         concatenated-stream
  86                         parse-error
  87                         string
  88                         condition
  89                         pathname
  90                         string-stream
  91                         cons
  92                         print-not-readable
  93                         structure-class
  94                         control-error
  95                         program-error
  96                         structure-object
  97                         division-by-zero
  98                         random-state
  99                         style-warning
 100                         double-float
 101                         ratio
 102                         symbol
 103                         echo-stream
 104                         rational
 105                         synonym-stream
 106                         end-of-file
 107                         reader-error
 108                         t
 109                         error
 110                         readtable
 111                         two-way-stream
 112                         extended-char
 113                         real
 114                         type-error
 115                         file-error
 116                         restart
 117                         unbound-slot
 118                         file-stream
 119                         sequence
 120                         unbound-variable
 121                         fixnum
 122                         serious-condition
 123                         undefined-function
 124                         float
 125                         short-float
 126                         unsigned-byte
 127                         floating-point-inexact
 128                         signed-byte
 129                         vector
 130                         floating-point-invalid-operation
 131                         simple-array
 132                         warning
 133                         floating-point-overflow
 134                         simple-base-string
 135                         floating-point-underflow
 136                         simple-bit-vector)))
 137   (dolist (type standard-types)
 138     (format t "~&~S~%" type)
 139     (assert (not (sb-kernel:unknown-type-p (sb-kernel:specifier-type type))))
 140     (assert (atom (sb-kernel:type-specifier (sb-kernel:specifier-type type))))))
 141
 142 ;;; a bug underlying the reported bug #221: The SB-KERNEL type code
 143 ;;; signalled an error on this expression.
 144 (subtypep '(function (fixnum) (values package boolean))
 145           '(function (t) (values package boolean)))
 146
 147 ;;; bug reported by Valtteri Vuorik
 148 (compile nil '(lambda () (member (char "foo" 0) '(#\. #\/) :test #'char=)))
 149 (assert (not (equal (multiple-value-list
 150                      (subtypep '(function ()) '(function (&rest t))))
 151                     '(nil t))))
 152
 153 (assert (not (equal (multiple-value-list
 154                      (subtypep '(function (&rest t)) '(function ())))
 155                     '(t t))))
 156
 157 (assert (subtypep '(function)
 158                   '(function (&optional * &rest t))))
 159 (assert (equal (multiple-value-list
 160                 (subtypep '(function)
 161                           '(function (t &rest t))))
 162                '(nil t)))
 163 (assert (and (subtypep 'function '(function))
 164              (subtypep '(function) 'function)))
 165
 166 ;;; Absent any exciting generalizations of |R, the type RATIONAL is
 167 ;;; partitioned by RATIO and INTEGER.  Ensure that the type system
 168 ;;; knows about this.  [ the type system is permitted to return NIL,
 169 ;;; NIL for these, so if future maintenance breaks these tests that
 170 ;;; way, that's fine.  What the SUBTYPEP calls are _not_ allowed to
 171 ;;; return is NIL, T, because that's completely wrong. ]
 172 (assert (subtypep '(or integer ratio) 'rational))
 173 (assert (subtypep 'rational '(or integer ratio)))
 174 ;;; Likewise, these are allowed to return NIL, NIL, but shouldn't
 175 ;;; return NIL, T:
 176 (assert (subtypep t '(or real (not real))))
 177 (assert (subtypep t '(or keyword (not keyword))))
 178 (assert (subtypep '(and cons (not (cons symbol integer)))
 179                   '(or (cons (not symbol) *) (cons * (not integer)))))
 180 (assert (subtypep '(or (cons (not symbol) *) (cons * (not integer)))
 181                   '(and cons (not (cons symbol integer)))))
 182 (assert (subtypep '(or (eql 0) (rational (0) 10))
 183                   '(rational 0 10)))
 184 (assert (subtypep '(rational 0 10)
 185                   '(or (eql 0) (rational (0) 10))))
 186 ;;; Until sbcl-0.7.13.7, union of CONS types when the CDRs were the
 187 ;;; same type gave exceedingly wrong results
 188 (assert (null (subtypep '(or (cons fixnum single-float)
 189                              (cons bignum single-float))
 190                         '(cons single-float single-float))))
 191 (assert (subtypep '(cons integer single-float)
 192                   '(or (cons fixnum single-float) (cons bignum single-float))))
 193
 194 (assert (not (nth-value 1 (subtypep '(and null some-unknown-type)
 195                                     'another-unknown-type))))
 196
 197 ;;; bug 46c
 198 (dolist (fun '(and if))
 199   (assert (raises-error? (coerce fun 'function) type-error)))
 200
 201 (dotimes (i 100)
 202   (let ((x (make-array 0 :element-type `(unsigned-byte ,(1+ i)))))
 203     (eval `(typep ,x (class-of ,x)))))