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