private/tests/class.ss
(module class mzscheme
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 1)))
  (require (lib "class.ss"))
  (require "../../class.ss")
  (require (lib "match.ss"))
  (require (prefix plt: (lib "plt-match.ss")))

  (define my-class%
    (class object%
      (public my-method)
      (init-private foo)
      (init-private (bar 'default-bar))
      (field (mumble 55))
      (define (my-method)
        (list foo bar))
      (super-new)))

  (define x (new my-class% (foo 'a-foo-value)))
  (define y (new my-class% (foo 'another-foo) (bar 'bar-bar-bar)))

  ;; TODO: make some tests!
  ;;  - default values
  ;;  - check that private names are private
  ;;  - check that init and init-field are distinct

  (define test-%
    (make-test-suite
     "% tests"
     (make-test-case "field name used as variable name"
                     (assert = (match x
                                 [(% my-class% mumble)
                                  mumble])
                             55))
     (make-test-case "field name bound to another name"
                     (assert = (match x
                                 [(% my-class% [fumble mumble])
                                  fumble])
                             55))
     (make-test-case "method call"
                     (assert-equal? (match x
                                      [(% my-class% [foo (my-method)])
                                       foo])
                                    '(a-foo-value default-bar)))
     (make-test-case "field name used as variable name (plt-match)"
                     (assert = (plt:match x
                                 [(% my-class% mumble)
                                  mumble])
                             55))
     (make-test-case "field name bound to another name (plt-match)"
                     (assert = (plt:match x
                                 [(% my-class% [fumble mumble])
                                  fumble])
                             55))
     (make-test-case "method call (plt-match)"
                     (assert-equal? (plt:match x
                                      [(% my-class% [foo (my-method)])
                                       foo])
                                    '(a-foo-value default-bar)))
     ))

  (define test-class
    (make-test-suite
     "all class.ss tests"
     test-%
     ))

  (provide test-class))