X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompound-cons.impure.lisp;h=fc15d174e4c49ad1acf12da5af7d181f912a6788;hb=fd210120f575183fbb5493a7ebc6b32aab107466;hp=cce5ac0806c44ffcbf738e4aec9fb2113dd8ebd9;hpb=2d65a5544c5134461574a0e69a6f1361bb98b27c;p=sbcl.git

diff --git a/tests/compound-cons.impure.lisp b/tests/compound-cons.impure.lisp
index cce5ac0..fc15d17 100644
--- a/tests/compound-cons.impure.lisp
+++ b/tests/compound-cons.impure.lisp
@@ -3,12 +3,30 @@
 ;;;; various patches made around May 2000 added support for this to
 ;;;; CMU CL. This file contains tests of their functionality.
 
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
 (cl:in-package :cl-user)
 
-(declaim (optimize (debug 3) (speed 2) (space 1)))
+;;; This block of eight assertions is taken directly from
+;;; 'Issue CONS-TYPE-SPECIFIER Writeup' in the ANSI spec.
+(assert (typep '(a b c) '(cons t)))
+(assert (typep '(a b c) '(cons symbol)))
+(assert (not (typep '(a b c) '(cons integer))))
+(assert (typep '(a b c) '(cons t t)))
+(assert (not (typep '(a b c) '(cons symbol symbol))))
+(assert (typep '(a b c) '(cons symbol (cons symbol (cons symbol)))))
+(assert (not (typep '(a b c) '(cons symbol (cons symbol (cons symbol nil))))))
+(assert (typep '(a b c) '(cons symbol (cons symbol (cons symbol null)))))
 
-;;; None of this is going to work until SBCL is patched.
-#|
 (assert (not (typep 11 'cons)))
 (assert (not (typep 11 '(cons *))))
 (assert (not (typep 11 '(cons t t))))
@@ -22,29 +40,26 @@
 (assert (typep '(100) '(cons number null)))
 (assert (not (typep '(100) '(cons number string))))
 
-(assert (typep '("yes" no) '(cons string symbol)))
-(assert (not (typep '(yes no) '(cons string symbol))))
-(assert (not (typep '(yes "no") '(cons string symbol))))
-(assert (typep '(yes "no") '(cons symbol)))
-(assert (typep '(yes "no") '(cons symbol t)))
-(assert (typep '(yes "no") '(cons t string)))
-(assert (not (typep '(yes "no") '(cons t null))))
+(assert (typep '("yes" . no) '(cons string symbol)))
+(assert (not (typep '(yes . no) '(cons string symbol))))
+(assert (not (typep '(yes . "no") '(cons string symbol))))
+(assert (typep '(yes . "no") '(cons symbol)))
+(assert (typep '(yes . "no") '(cons symbol t)))
+(assert (typep '(yes . "no") '(cons t string)))
+(assert (not (typep '(yes . "no") '(cons t null))))
 
 (assert (subtypep '(cons t) 'cons))
-(assert (subtypep 'cons '(cons t) ))
+(assert (subtypep 'cons '(cons t)))
 (assert (subtypep '(cons t *) 'cons))
-(assert (subtypep 'cons '(cons t *) ))
+(assert (subtypep 'cons '(cons t *)))
 (assert (subtypep '(cons * *) 'cons))
-(assert (subtypep 'cons '(cons * *) ))
+(assert (subtypep 'cons '(cons * *)))
 
-(assert (subtypep '(cons number *) 'cons ))
+(assert (subtypep '(cons number *) 'cons))
 (assert (not (subtypep 'cons '(cons number *))))
-(assert (subtypep '(cons * number) 'cons ))
+(assert (subtypep '(cons * number) 'cons))
 (assert (not (subtypep 'cons '(cons * number))))
-(assert (subtypep '(cons structure-object number) 'cons ))
+(assert (subtypep '(cons structure-object number) 'cons))
 (assert (not (subtypep 'cons '(cons structure-object number))))
 
 (assert (subtypep '(cons null fixnum) (type-of '(nil 44))))
-|#
-
-(sb-ext:quit :unix-status 104) ; success