tests/compound-cons.impure.lisp

   1 ;;;; ANSI requires CONS be supported as a compound type. The CMU CL
   2 ;;;; version which SBCL was forked from didn't support this, but
   3 ;;;; various patches made around May 2000 added support for this to
   4 ;;;; CMU CL. This file contains tests of their functionality.
   5
   6 ;;;; This software is part of the SBCL system. See the README file for
   7 ;;;; more information.
   8 ;;;;
   9 ;;;; While most of SBCL is derived from the CMU CL system, the test
  10 ;;;; files (like this one) were written from scratch after the fork
  11 ;;;; from CMU CL.
  12 ;;;;
  13 ;;;; This software is in the public domain and is provided with
  14 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  15 ;;;; more information.
  16
  17 (cl:in-package :cl-user)
  18
  19 ;;; This block of eight assertions is taken directly from
  20 ;;; 'Issue CONS-TYPE-SPECIFIER Writeup' in the ANSI spec.
  21 (assert (typep '(a b c) '(cons t)))
  22 (assert (typep '(a b c) '(cons symbol)))
  23 (assert (not (typep '(a b c) '(cons integer))))
  24 (assert (typep '(a b c) '(cons t t)))
  25 (assert (not (typep '(a b c) '(cons symbol symbol))))
  26 (assert (typep '(a b c) '(cons symbol (cons symbol (cons symbol)))))
  27 (assert (not (typep '(a b c) '(cons symbol (cons symbol (cons symbol nil))))))
  28 (assert (typep '(a b c) '(cons symbol (cons symbol (cons symbol null)))))
  29
  30 (assert (not (typep 11 'cons)))
  31 (assert (not (typep 11 '(cons *))))
  32 (assert (not (typep 11 '(cons t t))))
  33
  34 (assert (not (typep '() 'cons)))
  35 (assert (typep '(100) 'cons))
  36 (assert (typep '(100) '(cons t)))
  37 (assert (typep '(100) '(cons number)))
  38 (assert (not (typep '(100) '(cons character))))
  39 (assert (typep '(100) '(cons number t)))
  40 (assert (typep '(100) '(cons number null)))
  41 (assert (not (typep '(100) '(cons number string))))
  42
  43 (assert (typep '("yes" . no) '(cons string symbol)))
  44 (assert (not (typep '(yes . no) '(cons string symbol))))
  45 (assert (not (typep '(yes . "no") '(cons string symbol))))
  46 (assert (typep '(yes . "no") '(cons symbol)))
  47 (assert (typep '(yes . "no") '(cons symbol t)))
  48 (assert (typep '(yes . "no") '(cons t string)))
  49 (assert (not (typep '(yes . "no") '(cons t null))))
  50
  51 (assert (subtypep '(cons t) 'cons))
  52 (assert (subtypep 'cons '(cons t)))
  53 (assert (subtypep '(cons t *) 'cons))
  54 (assert (subtypep 'cons '(cons t *)))
  55 (assert (subtypep '(cons * *) 'cons))
  56 (assert (subtypep 'cons '(cons * *)))
  57
  58 (assert (subtypep '(cons number *) 'cons))
  59 (assert (not (subtypep 'cons '(cons number *))))
  60 (assert (subtypep '(cons * number) 'cons))
  61 (assert (not (subtypep 'cons '(cons * number))))
  62 (assert (subtypep '(cons structure-object number) 'cons))
  63 (assert (not (subtypep 'cons '(cons structure-object number))))
  64
  65 (assert (subtypep '(cons null fixnum) (type-of '(nil 44))))
  66
  67 (sb-ext:quit :unix-status 104) ; success