From 3b125d58fc69f33ca1d5c33bdca77c429ac66846 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Sat, 20 Feb 2010 08:08:17 +0000 Subject: [PATCH] Tests for internal dynamic dispatch (Java-only) svn: r18209 --- collects/tests/mzscheme/contract-test.ss | 48 ++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss index c3e1375102..651d8a7d81 100644 --- a/collects/tests/mzscheme/contract-test.ss +++ b/collects/tests/mzscheme/contract-test.ss @@ -4594,6 +4594,54 @@ (define/public (m) (set! f #f)))]) (send (new d%) m))) + (test/spec-passed + 'class/c-higher-order-override-1 + '(let* ([c% (contract (class/c (override [m (-> number? number?)])) + (class object% (super-new) + (define/public (m x) x) + (define/public (f x) (m x))) + 'pos + 'neg)] + [d% (class c% (super-new) + (define/override (m x) (add1 (super m x))))]) + (send (new d%) f 3))) + + (test/neg-blame + 'class/c-higher-order-override-2 + '(let* ([c% (contract (class/c (override [m (-> number? number?)])) + (class object% (super-new) + (define/public (m x) x) + (define/public (f x) (add1 (m x)))) + 'pos + 'neg)] + [d% (class c% (super-new) + (define/override (m x) (zero? (super m x))))]) + (send (new d%) f 3))) + + (test/neg-blame + 'class/c-higher-order-override-3 + '(let* ([c% (contract (class/c (override [m (-> number? number?)])) + (class object% (super-new) + (define/public (m x) (zero? x)) + (define/public (f x) (add1 (m x)))) + 'pos + 'neg)] + [d% (class c% (super-new) + (define/override (m x) (super m x)))]) + (send (new d%) f 3))) + + (test/pos-blame + 'class/c-higher-order-override-4 + '(let* ([c% (contract (class/c (override [m (-> number? number?)])) + (class object% (super-new) + (define/public (m x) x) + (define/public (f x) (add1 (m #f)))) + 'pos + 'neg)] + [d% (class c% (super-new) + (define/override (m x) (+ x (super m x))))]) + (send (new d%) f 3))) + ; ; ; ;; ;; ; ;;