tests/deftype.impure.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 (load "assertoid.lisp")
  13 (use-package "ASSERTOID")
  14
  15 ;;; Check for correct defaulting of unsupplied parameters to *
  16 (deftype opt (&optional arg)
  17   `(integer 0 ,arg))
  18 (deftype opt-singleton (&optional (arg))
  19   `(integer 0 ,arg))
  20 (deftype key (&key arg)
  21   `(integer 0 ,arg))
  22 (deftype key-singleton (&key (arg))
  23   `(integer 0 ,arg))
  24
  25 (assert (typep 1 'opt))
  26 (assert (typep 1 'opt-singleton))
  27 (assert (typep 1 'key))
  28 (assert (typep 1 'key-singleton))
  29
  30 ;;; empty body
  31 (deftype deftype-with-empty-body ())
  32 (assert (subtypep 'deftype-with-empty-body nil))
  33 (assert (subtypep nil 'deftype-with-empty-body))
  34
  35 ;; Ensure that DEFTYPE can successfully replace a DEFSTRUCT type
  36 ;; definition.
  37 (defstruct foo)
  38 (assert (progn (deftype foo () 'integer)
  39                (null (find-class 'foo nil))
  40                t))
  41
  42 ;; Ensure that DEFCLASS after DEFTYPE nukes the lambda-list.
  43 (deftype bar (x) `(integer ,x))
  44 (assert (equal '(x) (sb-int:info :type :lambda-list 'bar)))
  45 (defclass bar () ())
  46 (assert (not (sb-int:info :type :lambda-list 'bar)))
  47
  48 ;; Need to work with plain symbols as the body.
  49 (defconstant whatever 't)
  50 (deftype anything () whatever)
  51 (assert (typep 42 'anything))