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

Tests to make sure the first-order parts of method contracts are attributed

Browse Source 
to the correct source upon failure.

svn: r18219
This commit is contained in:
Stevie Strickland 2010-02-20 10:46:54 +00:00
parent cd4aa4c6f6
commit c5c22e117c
1 changed files with 38 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4123,6 +4123,13 @@
'pos 'pos
'neg)) 'neg))
(test/pos-blame
'class/c-first-order-method-4
'(contract (class/c [m (-> any/c number? number?)])
(class object% (super-new) (define/public (m) 3))
'pos
'neg))
(test/pos-blame (test/pos-blame
'class/c-first-order-field-1 'class/c-first-order-field-1
'(contract (class/c (field [n number?])) '(contract (class/c (field [n number?]))
@ -4237,6 +4244,13 @@
'pos 'pos
'neg)) 'neg))
(test/pos-blame
'class/c-first-order-super-9
'(contract (class/c (super [m (-> any/c number? number?)]))
(class object% (super-new) (define/public (m) 3))
'pos
'neg))
(test/pos-blame (test/pos-blame
'class/c-first-order-inner-1 'class/c-first-order-inner-1
'(contract (class/c (inner [m (-> any/c number? number?)])) '(contract (class/c (inner [m (-> any/c number? number?)]))
@ -4298,6 +4312,14 @@
'neg)]) 'neg)])
(class c% (super-new) (define/augment (m) 5)))) (class c% (super-new) (define/augment (m) 5))))
(test/neg-blame
'class/c-first-order-inner-9
'(let* ([c% (contract (class/c (inner [m (-> any/c number? number?)]))
(class object% (super-new) (define/pubment (m x) (inner x m x)))
'pos
'neg)])
(class c% (super-new) (define/augment (m) 5))))
(test/pos-blame (test/pos-blame
'class/c-first-order-override-1 'class/c-first-order-override-1
'(contract (class/c (override [m (-> any/c number? number?)])) '(contract (class/c (override [m (-> any/c number? number?)]))
@ -4359,6 +4381,14 @@
'neg)]) 'neg)])
(class c% (super-new) (define/override (m) 5)))) (class c% (super-new) (define/override (m) 5))))
(test/neg-blame
'class/c-first-order-override-9
'(let ([c% (contract (class/c (override [m (-> any/c number? number?)]))
(class object% (super-new) (define/public (m x) 3))
'pos
'neg)])
(class c% (super-new) (define/override (m) 5))))
(test/pos-blame (test/pos-blame
'class/c-first-order-augment-1 'class/c-first-order-augment-1
'(contract (class/c (augment [m (-> any/c number? number?)])) '(contract (class/c (augment [m (-> any/c number? number?)]))
@ -4420,6 +4450,14 @@
'neg)]) 'neg)])
(class c% (super-new) (inherit m)))) (class c% (super-new) (inherit m))))
(test/pos-blame
'class/c-first-order-augment-9
'(let ([c% (contract (class/c (augment [m (-> any/c number? number?)]))
(class object% (super-new) (define/pubment (m) 3))
'pos
'neg)])
(class c% (super-new) (inherit m))))
(test/spec-passed (test/spec-passed
'class/c-higher-order-method-1 'class/c-higher-order-method-1
'(let ([c% (contract (class/c [m (-> any/c number? number?)]) '(let ([c% (contract (class/c [m (-> any/c number? number?)])