(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)))
(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))