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                         ;; (NOT CONS)
  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                         ;; MEMBER-TYPE #\a #\b ...
  64                         ;; standard-char
  65                         broadcast-stream
  66                         method
  67                         standard-class
  68                         built-in-class
  69                         method-combination
  70                         standard-generic-function
  71                         cell-error
  72                         nil
  73                         standard-method
  74                         character
  75                         null
  76                         standard-object
  77                         class
  78                         number
  79                         storage-condition
  80                         compiled-function
  81                         package
  82                         stream
  83                         complex
  84                         package-error
  85                         stream-error
  86                         concatenated-stream
  87                         parse-error
  88                         string
  89                         condition
  90                         pathname
  91                         ;; OR STRING-INPUT-STREAM STRING-OUTPUT-STREAM
  92                         ;; FILL-POINTER-OUTPUT-STREAM
  93                         ;; string-stream
  94                         cons
  95                         print-not-readable
  96                         structure-class
  97                         control-error
  98                         program-error
  99                         structure-object
 100                         division-by-zero
 101                         random-state
 102                         style-warning
 103                         double-float
 104                         ratio
 105                         symbol
 106                         echo-stream
 107                         rational
 108                         synonym-stream
 109                         end-of-file
 110                         reader-error
 111                         t
 112                         error
 113                         readtable
 114                         two-way-stream
 115                         ;; This one's hard: (AND BASE-CHAR (NOT BASE-CHAR))
 116                         ;;
 117                         ;; This is because it looks like
 118                         ;;   (AND CHARACTER (NOT BASE-CHAR))
 119                         ;; but CHARACTER is equivalent to
 120                         ;; BASE-CHAR. So if we fix intersection of
 121                         ;; obviously disjoint types and then do (the
 122                         ;; extended-char foo), we'll get back FOO is
 123                         ;; not a NIL. -- CSR, 2002-09-16.
 124                         ;; extended-char
 125                         real
 126                         type-error
 127                         file-error
 128                         restart
 129                         unbound-slot
 130                         file-stream
 131                         ;; (OR CONS NULL VECTOR)
 132                         ;; sequence
 133                         unbound-variable
 134                         fixnum
 135                         serious-condition
 136                         undefined-function
 137                         float
 138                         short-float
 139                         unsigned-byte
 140                         floating-point-inexact
 141                         signed-byte
 142                         vector
 143                         floating-point-invalid-operation
 144                         simple-array
 145                         warning
 146                         floating-point-overflow
 147                         simple-base-string
 148                         floating-point-underflow
 149                         simple-bit-vector)))
 150   (dolist (type standard-types)
 151     (format t "~&~S~%" type)
 152     (assert (not (sb-kernel:unknown-type-p (sb-kernel:specifier-type type))))
 153     (assert (atom (sb-kernel:type-specifier (sb-kernel:specifier-type type))))))