suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

I think that finishes all the first order tests.

Browse Source 
svn: r18167
This commit is contained in:
Stevie Strickland 2010-02-18 22:53:35 +00:00
parent b15dd9e689
commit 8d9eda1459
1 changed files with 92 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
collects/tests/mzscheme/contract-test.ss
View File

@ -4197,6 +4197,98 @@
'pos 'pos
'neg)) 'neg))
(test/pos-blame
'class/c-first-order-override-1
'(contract (class/c (override [m (-> any/c number? number?)]))
object%
'pos
'neg))
(test/spec-passed
'class/c-first-order-override-2
'(contract (class/c (override [m (-> any/c number? number?)]))
(class object% (super-new) (define/public (m x) (add1 x)))
'pos
'neg))
(test/pos-blame
'class/c-first-order-override-3
'(contract (class/c (override [m (-> any/c number? number?)]))
(class object% (super-new) (define/pubment (m x) (add1 x)))
'pos
'neg))
(test/pos-blame
'class/c-first-order-override-4
'(contract (class/c (override [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) (+ (super m x) (inner x m x)))))
'pos
'neg))
(test/spec-passed
'class/c-first-order-override-5
'(contract (class/c (override [m (-> any/c number? number?)]))
(let ([c% (class object% (super-new) (define/public (m x) (add1 x)))])
(class c% (super-new) (define/override (m x) (add1 (super m x)))))
'pos
'neg))
(test/pos-blame
'class/c-first-order-override-6
'(contract (class/c (override [m (-> any/c number? number?)]))
(let* ([c% (class object% (super-new) (define/public (m x) (add1 x)))]
[d% (class c% (super-new) (define/overment (m x) (+ (super m x) (inner x m x))))])
(class d% (super-new) (define/augride (m x) x)))
'pos
'neg))
(test/pos-blame
'class/c-first-order-augment-1
'(contract (class/c (augment [m (-> any/c number? number?)]))
object%
'pos
'neg))
(test/spec-passed
'class/c-first-order-augment-2
'(contract (class/c (augment [m (-> any/c number? number?)]))
(class object% (super-new) (define/pubment (m x) (add1 x)))
'pos
'neg))
(test/pos-blame
'class/c-first-order-augment-3
'(contract (class/c (augment [m (-> any/c number? number?)]))
(class object% (super-new) (define/public (m x) (add1 x)))
'pos
'neg))
(test/spec-passed
'class/c-first-order-augment-4
'(contract (class/c (augment [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))
(test/pos-blame
'class/c-first-order-augment-5
'(contract (class/c (augment [m (-> any/c number? number?)]))
(let ([c% (class object% (super-new) (define/public (m x) (add1 x)))])
(class c% (super-new) (define/override (m x) (add1 (super m x)))))
'pos
'neg))
(test/spec-passed
'class/c-first-order-augment-6
'(contract (class/c (augment [m (-> any/c number? number?)]))
(let* ([c% (class object% (super-new) (define/public (m x) (add1 x)))]
[d% (class c% (super-new) (define/overment (m x) (+ (super m x) (inner x m x))))])
(class d% (super-new) (define/augride (m x) x)))
'pos
'neg))
; ;
; ;
; ;; ;; ; ;; ; ;; ;; ; ;;