; Test MzScheme's object system

(load-relative "loadtest.ss")

(require mzlib/class)

(Section 'object)

(define (stx-test e)
  (syntax-test (datum->syntax-object #f e #f)))
(define (err-test e exn)
  (error-test (datum->syntax-object #f e #f) exn))

(define (test-class* cl* renames)
  (stx-test  `(,cl*))
  (stx-test  `(,cl* ,@renames . x))
  (stx-test  `(,cl* ,@renames 0))
  (stx-test  `(,cl* ,@renames object% . x))
  (stx-test  `(,cl* ,@renames object% 0))
  (stx-test  `(,cl* ,@renames object% x))
  (stx-test  `(,cl* ,@renames object% ()))
  (stx-test  `(,cl* ,@renames object% () (0) x))
  (stx-test  `(,cl* ,@renames object% () 0))
  (stx-test  `(,cl* ,@renames object% () . x))
  (stx-test  `(,cl* ,@renames object% () () . x))
  (stx-test  `(,cl* ,@renames object% () () x))
  (stx-test  `(,cl* ,@renames object% () () public))
  (stx-test  `(,cl* ,@renames object% () () (x)))
  (stx-test  `(,cl* ,@renames object% () (x) ()))

  (let ()
    (define (try-dotted cl)
      (stx-test  `(,cl* ,@renames object% () () (,cl . x))))
    
    (map try-dotted '(public override private inherit rename
			     inherit-from rename-from
			     sequence)))
  
  (let ()
    (define (try-defn-kind cl)
      (stx-test  `(,cl* ,@renames object% () () (,cl 8)))
      (stx-test  `(,cl* ,@renames object% () () (,cl [8 9])))
      (stx-test  `(,cl* ,@renames object% () () (,cl [(x) 9])))
      (stx-test  `(,cl* ,@renames object% () () (,cl [(x y x) 9])))
      (stx-test  `(,cl* ,@renames object% () () (,cl [x . 1])))
      (stx-test  `(,cl* ,@renames object% () () (,cl [x 1 . 3])))
      (stx-test  `(,cl* ,@renames object% () () (,cl [x 1 3]))))
    
    (try-defn-kind 'public)
    (try-defn-kind 'override)
    (try-defn-kind 'private))

  (let ()
    (define (try-defn-rename-kind cl)
      (stx-test  `(,cl* ,@renames object% () () (,cl [((x) y) 9])))
      (stx-test  `(,cl* ,@renames object% () () (,cl [(x (y)) 9])))
      (stx-test  `(,cl* ,@renames object% () () (,cl [(x . y) 9])))
      (stx-test  `(,cl* ,@renames object% () () (,cl [(x 1) 9])))
      (stx-test  `(,cl* ,@renames object% () () (,cl [(1 x) 9]))))
    (try-defn-rename-kind 'public)
    (try-defn-rename-kind 'override))

  (let ()
    (define (try-ref-kind cl)
      (stx-test  `(,cl* ,@renames object% () () (,cl 8)))
      (stx-test  `(,cl* ,@renames object% () () (,cl x 8)))
      (stx-test  `(,cl* ,@renames object% () () (,cl (x . y))))
      (stx-test  `(,cl* ,@renames object% () () (,cl (x y z)))))
    
    (map try-ref-kind '(inherit rename share)))
  (err-test `(,cl* ,@renames object% () () (inherit x)) exn:object?)
  (err-test `(,cl* ,@renames object% () () (inherit (x y))) exn:object?)
  (err-test `(,cl* ,@renames object% () () (override [x void])) exn:object?)
  (err-test `(,cl* ,@renames object% () () (override [(x y) void])) exn:object?)
  (stx-test  `(,cl* ,@renames object% () () (inherit (x y z))))
  (stx-test  `(,cl* ,@renames object% () () (inherit (x 5))))
  (stx-test  `(,cl* ,@renames object% () () (inherit (x))))
  (stx-test  `(,cl* ,@renames object% () () (rename x)))
  (stx-test  `(,cl* ,@renames object% () () (rename (x))))
  (stx-test  `(,cl* ,@renames object% () () (rename ((x) y))))
  (stx-test  `(,cl* ,@renames object% () () (rename ((x y) y))))
  (stx-test  `(,cl* ,@renames object% () () (rename ((1) y))))

  (stx-test  `(,cl* ,@renames object% () () (inherit x) (sequence (set! x 5))))
  (stx-test  `(,cl* ,@renames object% () () (rename [x y]) (sequence (set! x 5))))

  (stx-test  `(,cl* ,@renames object% () () (sequence 1 . 2)))
  
  (stx-test  `(,cl* ,@renames object% () () (public [x 7] [x 9])))
  (stx-test  `(,cl* ,@renames object% () (x) (public [x 7])))
  (stx-test  `(,cl* ,@renames object% () (x) (public [(x w) 7])))
  (stx-test  `(,cl* ,@renames object% () () (public [(x y) 7] [(z y) 9])))
  (stx-test  `(,cl* ,@renames object% () () (public [(x y) 7] [(x z) 9])))

  (stx-test  `(,cl* ,@renames object% a ()))
  (stx-test  `(,cl* ,@renames object% (1 . a) ())))

(test-class* 'class* ())
(test-class* 'class*/names '((this super)))

(stx-test #'(class*/names 8 object% () () ()))
(stx-test #'(class*/names () object% () ()))
(stx-test #'(class*/names (8) object% () ()))
(stx-test #'(class*/names (this . 8) object% () ()))
(stx-test #'(class*/names (this 8) object% () ()))
(stx-test #'(class*/names (this super-init . 8) object% () ()))
(stx-test #'(class*/names (this super-init 8) object% () ()))

(test #t class? (class* object% () ()))
(test #t class? (class* object% () ()))
(test #t class? (class* object% () x))
(test #t class? (class* object% () () (public)))
(test #t class? (class* object% () () (public sequence)))
(test #t class? (class* object% () (x) (public [(y x) 9])))
(test #t class? (class*/names (this super-init) object% () () (public)))

(define c (class object% () (public x)))
(err/rt-test (class c () (public x)) exn:object?)
(err/rt-test (class c () (public ([y x] 5))) exn:object?)
(err/rt-test (class c () (override ([x y] 5))) exn:object?)

(stx-test #'(interface))
(stx-test #'(interface . x))
(stx-test #'(interface 8))
(stx-test #'(interface () 8))
(stx-test #'(interface () x . y))
(stx-test #'(interface () x 8))
(stx-test #'(interface () x x))
(err/rt-test (interface (8) x) exn:object?)

(err/rt-test (interface ((class->interface (class object% ()))
			 (class->interface (class object% ()))))
	    exn:object?)

(err/rt-test (interface ((interface () x)) x) exn:object?)
(err/rt-test (interface ((interface ((interface () x)) y)) x) exn:object?)
(test #t interface? (let ([i (interface () x)]
			  [j (interface () x)])
		      (interface (i j) y)))
(err/rt-test (let ([i (interface () x)]
		   [j (interface () x)])
	       (interface (i j) x))
	    exn:object?)
(err/rt-test (interface ((class->interface (class object% () (public w)))) w)
	    exn:object?)

(test #t interface? (interface ()))
(test #t interface? (interface () x))
(test #f interface? (class* object% () ()))

(define i0.1 (interface () x y))
(define i0.2 (interface () y c d))
(define i1 (interface (i0.1 i0.2) e))
(define ix (interface () x y))

(test #t interface-extension? i1 i0.1)
(test #t interface-extension? i1 i0.2)
(test #f interface-extension? i0.1 i1)
(test #f interface-extension? i0.2 i1)
(test #f interface-extension? i0.2 i0.1)
(test #f interface-extension? i0.1 i0.2)

(err/rt-test (let [(bad (class* object% (i0.1) ()))] bad) exn:object?)
(test #t class? (class* object% (i0.1) () (public x y)))
(err/rt-test (let ([cl (class* object% (i0.1 i0.2) () (public x y c))]) cl) exn:object?)
(err/rt-test (class* object% (i1) () (public x y c)) exn:object?)
(test #t class? (class* object% (i0.1 i0.1) () (public x y c d)))
(err/rt-test (class* object% (i1) () (public x y c d)) exn:object?)
(test #t class? (class* object% (i1) () (public x y c d e)))

; No initialization:
(define no-init-c% (class* object% () ()))
(err/rt-test (make-object no-init-c%) exn:object?)

(define c1 
  (let ((v 10))
    (class* object% (i1) (in [in-2 'banana] . in-rest)
	   (public (x 1) (y 2))
	   (private (a in) (b3 3))
	   (public (b1 2) (b2 2) (e 0))
	   (public (c 3) (d 7)
		   (f-1-a (lambda () a))
		   (f-1-b1 (lambda () b1))
		   (f-1-b2 (lambda () b2))
		   (f-1-c (lambda () c))
		   (f-1-v (lambda () v))
		   (f-1-x (lambda () x))
		   (f-1-top-a (lambda () (ivar this a)))
		   (f-1-other-e (lambda (o) (ivar o e)))
		   (f-1-set-b2 (lambda (v) (set! b2 v) b2))
		   (f-1-in-2 (lambda () in-2))
		   (f-1-in-rest (lambda () in-rest)))
	   (sequence
	     (set! e in)
	     (super-init)))))
  
(test #t implementation? c1 i0.1)
(test #t implementation? c1 i0.2)
(test #t implementation? c1 (class->interface c1))
(test #t implementation? c1 i1)
(test #f implementation? c1 ix)

(test #t implementation? object% (class->interface object%))
(test #t implementation? c1 (class->interface c1))
(test #t implementation? (class c1 ()) (class->interface c1))
(let ([i (interface ((class->interface c1)))])
  (test #f implementation? c1 i)
  (test #t implementation? (class* c1 (i) ()) i))

(define o1 (make-object c1 0 'apple "first" "last"))

(define c2 
  (let ((v 20))
    (class c1 ()
	   (inherit b2 (sup-set-b2 f-1-set-b2))
	   (rename (also-e e)
		   (also-b2 b2))
	   (override (b1 5) (c 6))
	   (public (a 4)
		   (f-2-a (lambda () a))
		   (f-2-b1 (lambda () b1))
		   (f-2-b2 (lambda () b2))
		   (f-2-also-b2 (lambda () also-b2))
		   (f-2-c (lambda () c))
		   ((i-f-2-v f-2-v) (lambda () v))
		   (f-2-v-copy (lambda () (i-f-2-v)))
		   (f-2-set-b2 (lambda (v) (sup-set-b2 v))))
	   (private (y 3))
	   (sequence
	     (super-init 1)))))

(test #t implementation? c2 i0.1)
(test #t implementation? c2 i0.2)
(test #t implementation? c2 i1)
(test #f implementation? c2 ix)
(test #t implementation? c2 (class->interface c2))
(test #t implementation? c2 (class->interface c1))
(test #f implementation? c1 (class->interface c2))

(test #t interface-extension? (class->interface c2) (class->interface object%))
(test #t interface-extension? (class->interface c2) (class->interface c1))
(test #t interface-extension? (class->interface c2) (class->interface c2))
(test #f interface-extension? (class->interface c1) (class->interface c2))
(test #t interface-extension? (class->interface c2) i0.1)
(test #f interface-extension? i0.1 (class->interface c2))

(define o2 (make-object c2))

(define c2.1
  (class*/names (this c2-init) c2 () ()
	  (sequence
	    (c2-init))))

(define o2.1 (make-object c2.1))

(test #t interface? (interface ((class->interface c2)
				(class->interface c2.1))))

(define c3
  (class* object% () ()
	  (public (x 6) (z 7) (b2 8)
		  (f-3-b2 (lambda () b2)))
	  (sequence (super-init))))

(define o3 (make-object c3))

(define c6
  (class object% (x-x)
    (public
     [(i-a x-a) (lambda () 'x-a)]
     [(x-a i-a) (lambda () 'i-a)]
     [(i-x x-x) (lambda () 'x-x)]
     [x-a-copy (lambda () (i-a))]
     [i-a-copy (lambda () (x-a))])
    (sequence (super-init))))

(define o6 (make-object c6 'bad))

(define c7
  (class*/names (self super-init) object% () ()
    (public
     [get-self (lambda () self)])
    (sequence (super-init))))

(define o7 (make-object c7))

(define display-test 
  (lambda (p v)
    (printf "Should be ~s: ~s ~a~n"
	    p v (if (equal? p v)
		    ""
		    "ERROR"))))

(define ivar? exn:object?)

(test #t is-a? o1 c1)
(test #t is-a? o1 i1)
(test #t is-a? o1 (class->interface c1))
(test #f is-a? o1 (interface ((class->interface c1))))
(test #t is-a? o2 c1)
(test #t is-a? o2 i1)
(test #f is-a? o1 c2)
(test #f is-a? o1 (class->interface c2))
(test #t is-a? o2 c2)
(test #t is-a? o2.1 c1)
(test #f is-a? o1 c3)
(test #f is-a? o2 c3)
(test #f is-a? o1 ix)
(test #f is-a? o2 ix)
(test #f is-a? o3 i1)
(test #f is-a? i1 i1)
(test #t subclass? c2 c1)
(test #t subclass? c2.1 c1)
(test #f subclass? c1 c2)
(test #f subclass? c1 c3)
(test #f subclass? i1 c3)
(test #t ivar-in-interface? 'f-1-a (class->interface c1))
(test #t ivar-in-interface? 'f-1-a (class->interface c2))
(test #f ivar-in-interface? 'f-2-a (class->interface c1))
(test #t ivar-in-interface? 'f-2-a (class->interface c2))
(test #t ivar-in-interface? 'x i0.1)
(test #t ivar-in-interface? 'x i1)
(test #f ivar-in-interface? 'x i0.2)
(test #f ivar-in-interface? 'c i0.1)
(test #t ivar-in-interface? 'c i0.2)
(test #t ivar-in-interface? 'c i1)
(test #f ivar-in-interface? 'zzz i1)
(test #t ivar-in-interface? 'f-1-a (class->interface c2))
(test #t ivar-in-interface? 'f-1-a (interface ((class->interface c2)) one-more-method))
(test #f ivar-in-interface? 'f-2-a (class->interface c1))

(err/rt-test (is-a? o1 o1))
(err/rt-test (subclass? o1 o1))
(err/rt-test (subclass? o1 i1))
(err/rt-test (implementation? o1 o1))
(err/rt-test (implementation? o1 c1))
(err/rt-test (ivar-in-interface? 0 i1))
(err/rt-test (ivar-in-interface? 'a o1))
(err/rt-test (ivar-in-interface? 'a c1))
(err/rt-test (ivar-in-interface? 'a o1))

(define (test/list l1 l2)
  (test #t 'ivar-list (and (= (length l1)
			      (length l2))
			   (andmap (lambda (i) (member i l2))
				   l1)
			   #t)))

(test/list '(hi there)
	   (interface->ivar-names 
	    (interface () hi there)))
(test/list '(hi too mee there)
	   (interface->ivar-names 
	    (interface ((interface () hi there)) mee too)))
(test/list '(hi too mee z y there) 
	   (interface->ivar-names 
	    (interface ((interface ((class->interface 
				     (class object% () 
				       (public y z)
				       (private nono)))) 
			  hi there)) 
	      mee too)))


(test 0 class-initialization-arity object%)
(test #t arity-at-least? (class-initialization-arity c1))
(test 1 arity-at-least-value (class-initialization-arity c1))
(test 0 class-initialization-arity c2)

(test '(1 2) class-initialization-arity (class object% (a [b 2])))

(arity-test object? 1 1)
(arity-test class? 1 1)
(arity-test interface? 1 1)
(arity-test is-a? 2 2)
(arity-test subclass? 2 2)
(arity-test interface-extension? 2 2)
(arity-test ivar-in-interface? 2 2)
(arity-test class-initialization-arity 1 1)

(arity-test ivar/proc 2 2)
(arity-test make-generic/proc 2 2)

(err/rt-test (ivar o1 a) ivar?)
(test 4 ivar/proc o2 'a)

(define (ivar-tests -ivar xtra-ok?)
  (stx-test  `(,-ivar))
  (stx-test  `(,-ivar 7))
  (stx-test  `(,-ivar 7 8))
  (stx-test  `(,-ivar 7 (x)))
  (stx-test  `(,-ivar 7 8 9))
  (unless xtra-ok?
    (stx-test  `(,-ivar 7 x 9))))
(ivar-tests 'ivar #f)
(ivar-tests 'send #t)
(ivar-tests 'make-generic #f)

(test 0 'send (send o1 f-1-a))
(test 1 'send (send o2 f-1-a))
(test 4 'send (send o2 f-2-a))

(test 'apple 'send (send o1 f-1-in-2))
(test 'banana 'send (send o2 f-1-in-2))
(test '("first" "last") 'send (send o1 f-1-in-rest))
(test '() 'send (send o2 f-1-in-rest))

(err/rt-test (send o1 f-1-top-a) ivar?)
(test 4 'send (send o2 f-1-top-a))

(test 5 ivar/proc o2 'b1)

(test 2 'send (send o1 f-1-b1))
(test 2 'send (send o1 f-1-b2))
(test 5 'send (send o2 f-1-b1))
(test 2 'send (send o2 f-1-b2))
(test 5 'send (send o2 f-2-b1))
(test 2 'send (send o2 f-2-b2))
(test 2 'send (send o2 f-2-also-b2))

(test 3 ivar/proc o1 'c)
(test 6 ivar/proc o2 'c)

(test 3 'send (send o1 f-1-c))
(test 6 'send (send o2 f-1-c))
(test 6 'send (send o2 f-2-c))

(test 7 ivar/proc o1 'd)
(test 7 ivar/proc o2 'd)

(test 10 'send (send o1 f-1-v))
(test 10 'send (send o2 f-1-v))
(test 20 'send (send o2 f-2-v))
(test 20 'send (send o2 f-2-v-copy))

(err/rt-test (ivar o2 i-f-2-v) ivar?)

(test 0 'send (send o1 f-1-other-e o1))
(test 1 'send (send o1 f-1-other-e o2))

(test 2 ivar/proc o2 'y)

(test 3 'send (send o2 f-2-set-b2 3))
(test 3 'send (send o2 f-2-also-b2))

(test 'i-a 'send (send o6 i-a))
(test 'x-a 'send (send o6 x-a))
(test 'i-a 'send (send o6 i-a-copy))
(test 'x-a 'send (send o6 x-a-copy))
(test 'x-x 'send (send o6 x-x))

(test #t eq? o7 (send o7 get-self))

(define g1 (make-generic c1 x))
(test 1 g1 o1)
(test 1 g1 o2)
(arity-test g1 1 1)

(err/rt-test (make-generic c1 www)  exn:object?)

(define g2 (make-generic c2 x))
(test 1 g2 o2)

(define g0 (make-generic i0.1 x))
(test 1 g0 o1)
(test 1 g0 o2)
(arity-test g0 1 1)
(test 'hi g0 (make-object (class* object% (i0.1) () 
				  (public [x 'hi][y 'bye])
				  (sequence (super-init)))))

(err/rt-test (make-generic i0.1 www) exn:object?)

(err/rt-test (g2 o1) exn:object?)
(err/rt-test (g0 o3) exn:object?)

(err/rt-test (class* 7 () ()) exn:object?)
(err/rt-test (class* null () ()) exn:object?)
(err/rt-test (let ([c (class* 7 () ())]) c) exn:object?)
(err/rt-test (class* object% (i1 7) ()) exn:object?)
(err/rt-test (let ([c (class* object% (i1 7) ())]) c) exn:object?)
(err/rt-test (interface (8) x) exn:object?)
(err/rt-test (let ([i (interface (8) x)]) i) exn:object?)
(err/rt-test (interface (i1 8) x) exn:object?)
(err/rt-test (make-generic c2 not-there) exn:object?)

(err/rt-test (make-object (class* c1 () ())) exn:object?)
(err/rt-test (make-object (let ([c (class* c1 () ())]) c)) exn:object?)

(err/rt-test (make-object 
	      (class* c2 () () (sequence (super-init) (super-init)))) 
	    exn:object?)
(err/rt-test (make-object 
	      (let ([c (class* c2 () () (sequence (super-init) (super-init)))]) c))
	    exn:object?)

(err/rt-test (make-object (class object% (x))) exn:application:arity?)
(err/rt-test (make-object (let ([c (class object% (x))]) c)) exn:application:arity?)
	      

(define c100
  (let loop ([n 99][c (class c1 args (public [z -1]) (sequence (apply super-init args)))])
    (if (zero? n)
	c
	(loop (sub1 n) (class c args 
			      (override (z n))
			      (sequence
				(apply super-init args)))))))

(define o100 (make-object c100 100))
(test 100 'send (send o100 f-1-a))
(test 1 'ivar (ivar o100 z))

(test 5 'init (let ([g-x 8]) (make-object (class* object% () ([x (set! g-x 5)]) (sequence (super-init)))) g-x))
(test 8 'init (let ([g-x 8]) (make-object (class* object% () ([x (set! g-x 5)]) (sequence (super-init))) 0) g-x))

(test (letrec ([x x]) x) 'init (send (make-object 
				      (class* object% () ([x y] [y x]) 
					      (public (f (lambda () x)))
					      (sequence (super-init))))
				     f))

(define inh-test-expr
 (lambda (super derive-pre? rename? override? override-pre?)
   (let* ([order
	   (lambda (pre? a b)
	     (if pre?
		 (list a b)
		 (list b a)))]
	  [base-class
	   `(class ,(if super
			super
			'(class object% (n) 
				(public [name (lambda () n)])
				(sequence (super-init))))
		   ()
		   ,(if (not rename?)
			'(inherit name)
			'(rename [super-name name]))
		   ,@(order
		      derive-pre?
		      `(public [w ,(if rename? 'super-name 'name)])
		      '(sequence (super-init 'tester))))])
     `(ivar
       (make-object
	,(if override?
	     `(class ,base-class ()
		     ,@(order
			override-pre?
			'(sequence (super-init))
			'(override [name (lambda () 'o-tester)])))
	     base-class))
       w))))

(define (do-override-tests super)
  (define (eval-test v e)
    (teval `(test ,v (quote, e)
		  (let ([v ,e]) 
		    (if (procedure? v)
			(v)
			v)))))

  (eval-test '(letrec ([x x]) x) (inh-test-expr super #t #f  #f #f))
  (eval-test '(letrec ([x x]) x) (inh-test-expr super #t #f  #t #t))
  (eval-test '(letrec ([x x]) x) (inh-test-expr super #f #f  #t #t))

  (eval-test '(letrec ([x x]) x) (inh-test-expr super #t #t  #f #f))
  (eval-test '(letrec ([x x]) x) (inh-test-expr super #t #t  #t #f))
  (eval-test '(letrec ([x x]) x) (inh-test-expr super #t #t  #t #t))
  
  (eval-test ''tester (inh-test-expr super #f #f  #f #f))
  (eval-test ''o-tester (inh-test-expr super #t #f  #t #f))
  (eval-test ''o-tester (inh-test-expr super #f #f  #t #f))

  (eval-test ''tester (inh-test-expr super #f #t  #f #f))  
  (eval-test ''tester (inh-test-expr super #f #t  #t #t))
  (eval-test ''tester (inh-test-expr super #f #t  #t #f)))

(do-override-tests #f)

'(when (defined? 'primclass%)
  (err/rt-test (make-object primclass%) exn:application:arity?)
  (err/rt-test (make-object primsubclass%) exn:application:arity?)

  (let ()
    (define o (make-object primclass% 'tester))
    (arity-test (ivar o name) 0 0)
    (test 'tester (ivar o name))
    (test "primclass%" (ivar o class-name))
    
    (let ()
      (define o2 (make-object primsubclass% 'tester))
      (arity-test (ivar o2 name) 0 0)
      (arity-test (ivar o2 detail) 0 0)
      (test 'tester (ivar o2 name))
      (test #f (ivar o2 detail))
      (test "primsubclass%" (ivar o2 class-name))
      
      (do-override-tests 'primclass%)
      (do-override-tests 'primsubclass%)

      (let ()
	(define name-g (make-generic primclass% name))
	(define class-name-g (make-generic primclass% class-name))
	
	(define sub-name-g (make-generic primsubclass% name))
	(define sub-class-name-g (make-generic primsubclass% class-name))
	(define sub-detail-g (make-generic primsubclass% detail))
	
	(test 'tester (name-g o))
	(test "primclass%" (class-name-g o))
	
	(test 'tester (name-g o2))
	(test "primsubclass%" (class-name-g o2))
	(test 'tester (sub-name-g o2))
	(test "primsubclass%" (sub-class-name-g o2))
	(test #f (sub-detail-g o2))

	(let ()
	  (define c%
	    (class primsubclass% ()
	      (inherit name detail class-name)
	      (sequence (super-init 'example))
	      (public
		[n name]
		[d detail]
		[c class-name])))

	  (define o3 (make-object c%))
	  (test 'example (ivar o3 n))
	  (test #f (ivar o3 d))
	  (test "primsubclass%" (ivar o3 c))
	  (test 'example (ivar o3 name))
	  (test #f (ivar o3 detail))
	  (test "primsubclass%" (ivar o3 class-name))

	  (test 'example (name-g o3))
	  (test "primsubclass%" (class-name-g o3))
	  (test 'example (sub-name-g o3))
	  (test "primsubclass%" (sub-class-name-g o3))
	  (test #f (sub-detail-g o3)))))))


; Test for override/rename order
(define bsc (class object% ()
		   (public [x (lambda () 10)])
		   (sequence (super-init))))
(define orc (class bsc ()
	      (public [y (lambda () (super-x))])
	      (override [x (lambda () 20)])
	      (rename [super-x x])
	      (sequence (super-init))))
(test 10 (ivar (make-object orc) y))

(report-errs)