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

A few more tests to make sure we have everything right for augment once

Browse Source 
implemented.

svn: r18216
This commit is contained in:
Stevie Strickland 2010-02-20 09:48:38 +00:00
parent 67d47e0a1d
commit 37e1cd2e2c
1 changed files with 49 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4699,14 +4699,60 @@
(test/neg-blame
'class/c-higher-order-augment-2
'(let* ([c% (contract (class/c (augment [m (-> any/c integer? integer?)]))
(class object% (super-new)
(define/pubment (m x) x)
(define/public (f x) (m (zero? x))))
(class object% (super-new) (define/pubment (m x) x))
'pos
'neg)]
[d% (class c% (super-new) (inherit m) (define/public (g x) (m x)))])
(send (new d%) g 3.5)))
(test/pos-blame
'class/c-higher-order-augment-3
'(let* ([c% (contract (class/c (augment [m (-> any/c integer? integer?)]))
(class object% (super-new) (define/pubment (m x) #f))
'pos
'neg)]
[d% (class c% (super-new) (inherit m) (define/public (g x) (m x)))])
(send (new d%) g 3)))
(test/pos-blame
'class/c-higher-order-augment-4
'(let* ([c% (contract (class/c (augment [m (-> any/c number? integer?)]))
(class object% (super-new) (define/pubment (m x) #f))
'pos
'neg1)]
[d% (contract (class/c (augment [m (-> any/c integer? number?)]))
c%
'pos1
'neg)]
[e% (class d% (super-new) (inherit m) (define/public (g x) (m x)))])
(send (new e%) g 3)))
(test/neg-blame
'class/c-higher-order-augment-4
'(let* ([c% (contract (class/c (augment [m (-> any/c number? integer?)]))
(class object% (super-new) (define/pubment (m x) (floor x)))
'pos
'neg1)]
[d% (contract (class/c (augment [m (-> any/c integer? number?)]))
c%
'pos1
'neg)]
[e% (class d% (super-new) (inherit m) (define/public (g x) (m x)))])
(send (new e%) g 3.5)))
(test/spec-passed
'class/c-higher-order-augment-4
'(let* ([c% (contract (class/c (augment [m (-> any/c number? integer?)]))
(class object% (super-new) (define/pubment (m x) (floor x)))
'pos
'neg1)]
[d% (contract (class/c (augment [m (-> any/c integer? number?)]))
(class c% (super-new) (inherit m) (define/public (f x) (m x)))
'pos1
'neg)]
[e% (class d% (super-new) (inherit m) (define/public (g x) (m x)))])
(send (new e%) f 3.5)))
;
;
; ;; ;; ; ;;