X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftype.pure.lisp;h=fcda6d6fe4a072c274e2889c50d1a27697cfe445;hb=f3b213e5fea9992b3a9a1f2a6c482239a1aff3c1;hp=a2c63ffeaba21874c31fdfedb9ef1c7586ad2f57;hpb=f0670f28705c01e79fb23cb2a582074d3e51ec98;p=sbcl.git

diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp
index a2c63ff..fcda6d6 100644
--- a/tests/type.pure.lisp
+++ b/tests/type.pure.lisp
@@ -27,4 +27,137 @@
 	    (12  (or null vector)              nil)
 	    (12  (and (or number vector) real) t))))
 
-	    
\ No newline at end of file
+
+;;; This test is motivated by bug #195, which previously had (THE REAL
+;;; #(1 2 3)) give an error which prints as "This is not a (OR
+;;; SINGLE-FLOAT DOUBLE-FLOAT RATIONAL)".  We ideally want all of the
+;;; defined-by-ANSI types to unparse as themselves or at least
+;;; something similar (e.g. CHARACTER can unparse to BASE-CHAR, since
+;;; the types are equivalent in current SBCL).
+(let ((standard-types '(;; from table 4-2 in section 4.2.3 in the
+			;; CLHS.
+			arithmetic-error
+			function
+			simple-condition           
+			array
+			generic-function
+			simple-error
+			;; so it might seem easy to change the HAIRY
+			;; :UNPARSE method to recognize that (NOT
+			;; CONS) should unparse as ATOM. However, we
+			;; then lose the nice (SUBTYPEP '(NOT ATOM)
+			;; 'CONS) => T,T behaviour that we get from
+			;; simplifying (NOT ATOM) -> (NOT (NOT CONS))
+			;; -> CONS. So, for now, we leave this
+			;; commented out.
+			;;
+			;; atom
+			hash-table
+			simple-string              
+			base-char
+			integer
+			simple-type-error          
+			base-string
+			keyword
+			simple-vector              
+			bignum
+			list
+			simple-warning             
+			bit
+			logical-pathname
+			single-float               
+			bit-vector
+			long-float
+			standard-char              
+			broadcast-stream
+			method
+			standard-class             
+			built-in-class
+			method-combination
+			standard-generic-function  
+			cell-error
+			nil
+			standard-method            
+			character
+			null
+			standard-object            
+			class
+			number
+			storage-condition          
+			compiled-function
+			package
+			stream                     
+			complex
+			package-error
+			stream-error               
+			concatenated-stream
+			parse-error
+			string                     
+			condition
+			pathname
+			string-stream
+			cons
+			print-not-readable
+			structure-class            
+			control-error
+			program-error
+			structure-object           
+			division-by-zero
+			random-state
+			style-warning              
+			double-float
+			ratio
+			symbol                     
+			echo-stream
+			rational
+			synonym-stream             
+			end-of-file
+			reader-error
+			t                          
+			error
+			readtable
+			two-way-stream
+			;; This one's hard: (AND BASE-CHAR (NOT BASE-CHAR))
+			;;
+			;; This is because it looks like
+			;;   (AND CHARACTER (NOT BASE-CHAR))
+			;; but CHARACTER is equivalent to
+			;; BASE-CHAR. So if we fix intersection of
+			;; obviously disjoint types and then do (the
+			;; extended-char foo), we'll get back FOO is
+			;; not a NIL. -- CSR, 2002-09-16.
+			;;
+			;; extended-char
+			real
+			type-error                 
+			file-error
+			restart
+			unbound-slot               
+			file-stream
+			sequence
+			unbound-variable           
+			fixnum
+			serious-condition
+			undefined-function         
+			float
+			short-float
+			unsigned-byte              
+			floating-point-inexact
+			signed-byte
+			vector                     
+			floating-point-invalid-operation
+			simple-array
+			warning                    
+			floating-point-overflow
+			simple-base-string                             
+			floating-point-underflow
+			simple-bit-vector)))
+  (dolist (type standard-types)
+    (format t "~&~S~%" type)
+    (assert (not (sb-kernel:unknown-type-p (sb-kernel:specifier-type type))))
+    (assert (atom (sb-kernel:type-specifier (sb-kernel:specifier-type type))))))
+
+;;; a bug underlying the reported bug #221: The SB-KERNEL type code
+;;; signalled an error on this expression.
+(subtypep '(function (fixnum) (values package boolean))
+	  '(function (t) (values package boolean)))