Check lots of crazy special cases for super contracts.

svn: r18163
This commit is contained in:
Stevie Strickland 2010-02-18 22:16:29 +00:00
parent a7d8507e3c
commit 690b82da14

View File

@ -4124,19 +4124,35 @@
'neg)) 'neg))
(test/pos-blame (test/pos-blame
'class/c-first-order-7 'class/c-first-order-8
'(contract (class/c (super [m (-> any/c number? number?)])) '(contract (class/c (super [m (-> any/c number? number?)]))
(class object% (super-new) (define/public-final (m x) (add1 x))) (class object% (super-new) (define/public-final (m x) (add1 x)))
'pos 'pos
'neg)) 'neg))
(test/pos-blame
'class/c-first-order-9
'(contract (class/c (super [m (-> any/c number? number?)]))
(let ([c% (class object% (super-new) (define/public (m x) (add1 x)))])
(class c% (super-new) (define/overment (m x) (add1 x))))
'pos
'neg))
(test/spec-passed (test/spec-passed
'class/c-first-order-8 'class/c-first-order-10
'(contract (class/c (super [m (-> any/c number? number?)])) '(contract (class/c (super [m (-> any/c number? number?)]))
(class object% (super-new) (define/public (m x) (add1 x))) (class object% (super-new) (define/public (m x) (add1 x)))
'pos 'pos
'neg)) 'neg))
(test/spec-passed
'class/c-first-order-11
'(contract (class/c (super [m (-> any/c number? number?)]))
(let ([c% (class object% (super-new) (define/pubment (m x) (inner x m x)))])
(class c% (super-new) (define/augride (m x) (add1 x))))
'pos
'neg))
; ;
; ;
; ;; ;; ; ;; ; ;; ;; ; ;;