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 (defun get-deftype-lambda-list (symbol)
  44   (let ((expander (sb-int:info :type :expander symbol)))
  45     (and (functionp expander)
  46          (sb-kernel:%fun-lambda-list expander))))
  47 (deftype bar (x) `(integer ,x))
  48 (assert (equal '(x) (get-deftype-lambda-list 'bar)))
  49 (defclass bar () ())
  50 (assert (not (get-deftype-lambda-list 'bar)))
  51
  52 ;; Need to work with plain symbols as the body.
  53 (defconstant whatever 't)
  54 (deftype anything () whatever)
  55 (assert (typep 42 'anything))
  56
  57 (with-test (:name :deftype-not-list-lambda-list)
  58   (assert-error (eval `(deftype ,(gensym) non-list-argument))))