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).
  37 (let ((standard-types '(;; from table 4-2 in section 4.2.3 in the
  38                         ;; CLHS.
  39                         arithmetic-error
  40                         function
  41                         simple-condition
  42                         array
  43                         generic-function
  44                         simple-error
  45                         ;; so it might seem easy to change the HAIRY
  46                         ;; :UNPARSE method to recognize that (NOT
  47                         ;; CONS) should unparse as ATOM. However, we
  48                         ;; then lose the nice (SUBTYPEP '(NOT ATOM)
  49                         ;; 'CONS) => T,T behaviour that we get from
  50                         ;; simplifying (NOT ATOM) -> (NOT (NOT CONS))
  51                         ;; -> CONS. So, for now, we leave this
  52                         ;; commented out.
  53                         ;;
  54                         ;; atom
  55                         hash-table
  56                         simple-string
  57                         base-char
  58                         integer
  59                         simple-type-error
  60                         base-string
  61                         keyword
  62                         simple-vector
  63                         bignum
  64                         list
  65                         simple-warning
  66                         bit
  67                         logical-pathname
  68                         single-float
  69                         bit-vector
  70                         long-float
  71                         standard-char
  72                         broadcast-stream
  73                         method
  74                         standard-class
  75                         built-in-class
  76                         method-combination
  77                         standard-generic-function
  78                         cell-error
  79                         nil
  80                         standard-method
  81                         character
  82                         null
  83                         standard-object
  84                         class
  85                         number
  86                         storage-condition
  87                         compiled-function
  88                         package
  89                         stream
  90                         complex
  91                         package-error
  92                         stream-error
  93                         concatenated-stream
  94                         parse-error
  95                         string
  96                         condition
  97                         pathname
  98                         string-stream
  99                         cons
 100                         print-not-readable
 101                         structure-class
 102                         control-error
 103                         program-error
 104                         structure-object
 105                         division-by-zero
 106                         random-state
 107                         style-warning
 108                         double-float
 109                         ratio
 110                         symbol
 111                         echo-stream
 112                         rational
 113                         synonym-stream
 114                         end-of-file
 115                         reader-error
 116                         t
 117                         error
 118                         readtable
 119                         two-way-stream
 120                         ;; This one's hard: (AND BASE-CHAR (NOT BASE-CHAR))
 121                         ;;
 122                         ;; This is because it looks like
 123                         ;;   (AND CHARACTER (NOT BASE-CHAR))
 124                         ;; but CHARACTER is equivalent to
 125                         ;; BASE-CHAR. So if we fix intersection of
 126                         ;; obviously disjoint types and then do (the
 127                         ;; extended-char foo), we'll get back FOO is
 128                         ;; not a NIL. -- CSR, 2002-09-16.
 129                         ;;
 130                         ;; extended-char
 131                         real
 132                         type-error
 133                         file-error
 134                         restart
 135                         unbound-slot
 136                         file-stream
 137                         sequence
 138                         unbound-variable
 139                         fixnum
 140                         serious-condition
 141                         undefined-function
 142                         float
 143                         short-float
 144                         unsigned-byte
 145                         floating-point-inexact
 146                         signed-byte
 147                         vector
 148                         floating-point-invalid-operation
 149                         simple-array
 150                         warning
 151                         floating-point-overflow
 152                         simple-base-string
 153                         floating-point-underflow
 154                         simple-bit-vector)))
 155   (dolist (type standard-types)
 156     (format t "~&~S~%" type)
 157     (assert (not (sb-kernel:unknown-type-p (sb-kernel:specifier-type type))))
 158     (assert (atom (sb-kernel:type-specifier (sb-kernel:specifier-type type))))))
 159
 160 ;;; a bug underlying the reported bug #221: The SB-KERNEL type code
 161 ;;; signalled an error on this expression.
 162 (subtypep '(function (fixnum) (values package boolean))
 163           '(function (t) (values package boolean)))
 164
 165 ;;; bug reported by Valtteri Vuorik
 166 (compile nil '(lambda () (member (char "foo" 0) '(#\. #\/) :test #'char=)))
 167 (assert (not (equal (multiple-value-list
 168                      (subtypep '(function ()) '(function (&rest t))))
 169                     '(nil t))))
 170 (assert (not (equal (multiple-value-list
 171                      (subtypep '(function (&rest t)) '(function ())))
 172                     '(t t))))