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 (cl:in-package :cl-user)
   7
   8 ;;; This block of eight assertions is taken directly from
   9 ;;; 'Issue CONS-TYPE-SPECIFIER Writeup' in the ANSI spec.
  10 (assert (typep '(a b c) '(cons t)))
  11 (assert (typep '(a b c) '(cons symbol)))
  12 (assert (not (typep '(a b c) '(cons integer))))
  13 (assert (typep '(a b c) '(cons t t)))
  14 (assert (not (typep '(a b c) '(cons symbol symbol))))
  15 (assert (typep '(a b c) '(cons symbol (cons symbol (cons symbol)))))
  16 (assert (not (typep '(a b c) '(cons symbol (cons symbol (cons symbol nil))))))
  17 (assert (typep '(a b c) '(cons symbol (cons symbol (cons symbol null)))))
  18
  19 (assert (not (typep 11 'cons)))
  20 (assert (not (typep 11 '(cons *))))
  21 (assert (not (typep 11 '(cons t t))))
  22
  23 (assert (not (typep '() 'cons)))
  24 (assert (typep '(100) 'cons))
  25 (assert (typep '(100) '(cons t)))
  26 (assert (typep '(100) '(cons number)))
  27 (assert (not (typep '(100) '(cons character))))
  28 (assert (typep '(100) '(cons number t)))
  29 (assert (typep '(100) '(cons number null)))
  30 (assert (not (typep '(100) '(cons number string))))
  31
  32 (assert (typep '("yes" . no) '(cons string symbol)))
  33 (assert (not (typep '(yes . no) '(cons string symbol))))
  34 (assert (not (typep '(yes . "no") '(cons string symbol))))
  35 (assert (typep '(yes . "no") '(cons symbol)))
  36 (assert (typep '(yes . "no") '(cons symbol t)))
  37 (assert (typep '(yes . "no") '(cons t string)))
  38 (assert (not (typep '(yes . "no") '(cons t null))))
  39
  40 (assert (subtypep '(cons t) 'cons))
  41 (assert (subtypep 'cons '(cons t)))
  42 (assert (subtypep '(cons t *) 'cons))
  43 (assert (subtypep 'cons '(cons t *)))
  44 (assert (subtypep '(cons * *) 'cons))
  45 (assert (subtypep 'cons '(cons * *)))
  46
  47 (assert (subtypep '(cons number *) 'cons))
  48 (assert (not (subtypep 'cons '(cons number *))))
  49 (assert (subtypep '(cons * number) 'cons))
  50 (assert (not (subtypep 'cons '(cons * number))))
  51 (assert (subtypep '(cons structure-object number) 'cons))
  52 (assert (not (subtypep 'cons '(cons structure-object number))))
  53
  54 (assert (subtypep '(cons null fixnum) (type-of '(nil 44))))
  55
  56 (sb-ext:quit :unix-status 104) ; success