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

bring back accidentally clobbered value-contract tests

Browse Source
This commit is contained in:
Robby Findler 2014-06-13 08:32:40 -05:00
parent 0a0c62a1e6
commit c06542b393
1 changed files with 44 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
pkgs/racket-pkgs/racket-test/tests/racket/contract/value-contract.rkt
View File

@ -1,8 +1,49 @@
#lang racket/base
(require "test-util.rkt")
(parameterize ([current-contract-namespace (make-basic-contract-namespace
'racket/contract)])
(parameterize ([current-contract-namespace
(make-basic-contract-namespace 'racket/unit 'racket/class 'racket/contract)])
(ctest #f value-contract #f)
(ctest #f value-contract (λ (x) x))
(ctest #f value-contract (unit (import) (export)))
(ctest #f value-contract object%)
(contract-eval
`(let ([ctc (-> number? number?)])
(,test ctc value-contract (contract ctc (λ (x) x) 'pos 'neg))))
(contract-eval
`(let ([ctc (->* (number?) (number?) number?)])
(,test ctc value-contract (contract ctc (λ (x [y 3]) x) 'pos 'neg))))
(contract-eval
`(let ([ctc (->d ([x number?]) ([y number?]) [_ number?])])
(,test ctc value-contract (contract ctc (λ (x [y 3]) x) 'pos 'neg))))
(contract-eval
`(let ([ctc (->i ([x number?]) ([y number?]) [_ number?])])
(,test ctc value-contract (contract ctc (λ (x [y 3]) x) 'pos 'neg))))
(contract-eval
`(let ([ctc (unconstrained-domain-> number?)])
(,test ctc value-contract (contract ctc (λ (x) 3) 'pos 'neg))))
(contract-eval
`(let ([ctc (case-> (-> number? number? number?) (-> number? number?))])
(,test ctc value-contract (contract ctc (case-lambda [(x) 3] [(x y) (+ x y)]) 'pos 'neg))))
(contract-eval
`(let ([ctc (box/c number?)])
(,test ctc value-contract (contract ctc (box 3) 'pos 'neg))))
(contract-eval
`(let ([ctc (hash/c number? number?)])
(,test ctc value-contract (contract ctc (make-hash) 'pos 'neg))))
(contract-eval
`(let ([ctc (vectorof number?)])
(,test ctc value-contract (contract ctc (vector 1 2 3) 'pos 'neg))))
(contract-eval
`(let ([ctc (vector/c number? number?)])
(,test ctc value-contract (contract ctc (vector 4 5) 'pos 'neg))))
(contract-eval
`(let ([ctc (object-contract)])
(,test ctc value-contract (contract ctc (new object%) 'pos 'neg))))
(test/spec-passed/result
'value-contract
@ -26,4 +67,4 @@
(or (and (has-blame? f)
(blame-positive (value-blame f)))
'pos))
'pos))
'pos))