/[gcl]/gcl/ansi-tests/types-and-class.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/types-and-class.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.26 by pfdietz, Wed Feb 5 03:40:35 2003 UTC revision 1.27 by pfdietz, Thu Feb 6 03:43:48 2003 UTC
# Line 161  Line 161 
161    (types-9a-body)    (types-9a-body)
162    0)    0)
163    
 ;;;  
 ;;; Check that disjointness of types in *disjoint-types-list*  
 ;;; is respected by all the elements of *universe*  
 ;;;  
 (deftest universe-elements-in-at-most-one-disjoint-type  
   (loop for e in *universe*  
         for types = (remove-if-not #'(lambda (x) (typep e x))  
                                    *disjoint-types-list*)  
         when (> (length types) 1)  
         collect (list e types))  
   nil)  
   
 ;;; Union of a type with its complement is universal  
   
 (deftest type-or-not-type-is-everything  
   (loop for l in *disjoint-types-list2*  
         append  
         (loop  
          for type in l  
          append (check-subtypep t `(or ,type (not ,type)) t)  
          append (check-subtypep t `(or (not ,type) ,type) t)))  
   nil)  
   
 (defclass tac-1-class () (a b c))  
 (defclass tac-1a-class (tac-1-class) (d e))  
 (defclass tac-1b-class (tac-1-class) (f g))  
   
 (deftest user-class-disjointness  
   (loop for l in *disjoint-types-list2*  
         append  
         (loop  
          for type in l  
          append (classes-are-disjoint type 'tac-1-class)))  
   nil)  
   
 (deftest user-class-disjointness-2  
   (check-disjointness 'tac-1a-class 'tac-1b-class)  
   nil)  
   
 (defstruct tac-2-struct a b c)  
 (defstruct (tac-2a-struct (:include tac-2-struct)) d e)  
 (defstruct (tac-2b-struct (:include tac-2-struct)) f g)  
   
 (deftest user-struct-disjointness  
   (loop for l in *disjoint-types-list2*  
         append  
         (loop  
          for type in l  
          append (check-disjointness type 'tac-2-struct)))  
   nil)  
   
 (deftest user-struct-disjointness-2  
   (check-disjointness 'tac-2a-struct 'tac-2b-struct)  
   nil)  
   
 (deftest integer-and-ratio-are-disjoint  
   (classes-are-disjoint 'integer 'ratio)  
   nil)  
   
 (deftest bignum-and-ratio-are-disjoint  
   (classes-are-disjoint 'bignum 'ratio)  
   nil)  
   
 (deftest bignum-and-fixnum-are-disjoint  
   (classes-are-disjoint 'bignum 'fixnum)  
   nil)  
164    
 (deftest fixnum-and-ratio-are-disjoint  
   (classes-are-disjoint 'fixnum 'ratio)  
   nil)  
   
 (deftest byte8-and-ratio-are-disjoint  
   (classes-are-disjoint '(unsigned-byte 8) 'ratio)  
   nil)  
   
 (deftest bit-and-ratio-are-disjoint  
   (classes-are-disjoint 'bit 'ratio)  
   nil)  
   
 (deftest integer-and-float-are-disjoint  
   (classes-are-disjoint 'integer 'float)  
   nil)  
   
 (deftest ratio-and-float-are-disjoint  
   (classes-are-disjoint 'ratio 'float)  
   nil)  
   
 (deftest complex-and-float-are-disjoint  
   (classes-are-disjoint 'complex 'float)  
   nil)  
   
 (deftest integer-subranges-are-disjoint  
   (classes-are-disjoint '(integer 0 (10)) '(integer 10 (20)))  
   nil)  
   
 (deftest keyword-and-null-are-disjoint  
   (classes-are-disjoint 'keyword 'null)  
   nil)  
   
 (deftest keyword-and-boolean-are-disjoint  
   (classes-are-disjoint 'keyword 'boolean)  
   nil)  
165    
166    
167  ;;; Check that all class names in CL that name standard-classes or  ;;; Check that all class names in CL that name standard-classes or
# Line 437  Line 336 
336                     (notnot-mv (typep env (type-of env)))))                     (notnot-mv (typep env (type-of env)))))
337      (%foo))      (%foo))
338    t)    t)
   

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26