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

Added tests for opaque class/c contracts.

Browse Source
This commit is contained in:
Asumu Takikawa 2012-01-12 17:43:00 -05:00
parent f1557bc4be
commit db3c96a2a0
1 changed files with 156 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

158
collects/tests/racket/contract-test.rktl
View File

@ -6374,6 +6374,20 @@
'pos
'neg))
(test/spec-passed
'class/c-first-order-opaque-class-1
'(contract (class/c #:opaque)
object%
'pos
'neg))
(test/pos-blame
'class/c-first-order-opaque-class-2
'(contract (class/c #:opaque)
(class object% (super-new) (define/public (m x) (add1 x)))
'pos
'neg))
(test/pos-blame
'class/c-first-order-method-1
'(contract (class/c [m (-> any/c number? number?)])
@ -6403,19 +6417,33 @@
'neg))
(test/spec-passed
'class/c-first-order-method-4
'class/c-first-order-method-5
'(contract (class/c m)
(class object% (super-new) (define/public (m) 3))
'pos
'neg))
(test/pos-blame
'class/c-first-order-method-4
'class/c-first-order-method-6
'(contract (class/c [m (-> any/c number? number?)])
(class object% (super-new) (define/public (m) 3))
'pos
'neg))
(test/spec-passed
'class/c-first-order-opaque-method-1
'(contract (class/c #:opaque [m (-> any/c number? number?)])
(class object% (super-new) (define/public (m x) 3))
'pos
'neg))
(test/pos-blame
'class/c-first-order-opaque-method-2
'(contract (class/c #:opaque [m (-> any/c number? number?)])
(class object% (super-new) (define/public (m x) 3) (define/public (n) 4))
'pos
'neg))
(test/pos-blame
'class/c-first-order-field-1
'(contract (class/c (field [n number?]))
@ -6444,6 +6472,20 @@
'pos
'neg))
(test/spec-passed
'class/c-first-order-opaque-field-1
'(contract (class/c #:opaque (field n))
(class object% (super-new) (field [n 3]))
'pos
'neg))
(test/pos-blame
'class/c-first-order-opaque-field-2
'(contract (class/c #:opaque (field n))
(class object% (super-new) (field [m 5] [n 3]))
'pos
'neg))
;; No true first-order tests here, other than just to make
;; sure they're accepted. For init-field, we can at least
;; make sure the given field is public (which happens
@ -6562,6 +6604,20 @@
'pos
'neg))
(test/pos-blame
'class/c-first-order-opaque-super-1
'(contract (class/c #:opaque (super m))
(class (class object% (super-new) (define/public (m) 3)) (super-new))
'pos
'neg))
(test/spec-passed
'class/c-first-order-opaque-super-2
'(contract (class/c #:opaque (super m) m)
(class (class object% (super-new) (define/public (m) 3)) (super-new))
'pos
'neg))
(test/pos-blame
'class/c-first-order-inner-1
'(contract (class/c (inner [m (-> any/c number? number?)]))
@ -6631,6 +6687,22 @@
'neg)])
(class c% (super-new) (define/augment (m) 5))))
(test/pos-blame
'class/c-first-order-opaque-inner-1
'(contract (class/c #:opaque (inner m))
(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/spec-passed
'class/c-first-order-opaque-inner-2
'(contract (class/c #:opaque (inner m) m)
(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-override-1
'(contract (class/c (override [m (-> any/c number? number?)]))
@ -6700,6 +6772,22 @@
'neg)])
(class c% (super-new) (define/override (m) 5))))
(test/pos-blame
'class/c-first-order-opaque-override-1
'(contract (class/c #:opaque (override m))
(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-opaque-override-2
'(contract (class/c #:opaque (override m) m)
(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-augment-1
'(contract (class/c (augment [m (-> any/c number? number?)]))
@ -6769,6 +6857,20 @@
'neg)])
(class c% (super-new) (inherit m))))
(test/pos-blame
'class/c-first-order-opaque-augment-1
'(contract (class/c #:opaque (augment m))
(class object% (super-new) (define/pubment (m x) (add1 x)))
'pos
'neg))
(test/spec-passed
'class/c-first-order-opaque-augment-2
'(contract (class/c #:opaque (augment m) m)
(class object% (super-new) (define/pubment (m x) (add1 x)))
'pos
'neg))
(test/pos-blame
'class/c-first-order-augride-1
'(contract (class/c (augride [m (-> any/c number? number?)]))
@ -6840,6 +6942,22 @@
'neg)])
(class c% (super-new) (inherit m))))
(test/pos-blame
'class/c-first-order-opaque-augride-1
'(contract (class/c #:opaque (augride m))
(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/spec-passed
'class/c-first-order-opaque-augride-2
'(contract (class/c #:opaque (augride m) m)
(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-inherit-1
'(let* ([c% (contract (class/c (inherit [m (-> any/c number? number?)]))
@ -6867,6 +6985,24 @@
[d% (class c% (super-new) (inherit m) (define/public (f) (m 5)))])
(send (new d%) f)))
(test/pos-blame
'class/c-first-order-opaque-inherit-1
'(let* ([c% (contract (class/c #:opaque (inherit [m (-> any/c number? number?)]))
(class object% (super-new) (define/public (m x) x))
'pos
'neg)]
[d% (class c% (super-new) (inherit m) (define/public (f) (m 5)))])
(send (new d%) f)))
(test/spec-passed
'class/c-first-order-opaque-inherit-2
'(let* ([c% (contract (class/c #:opaque m (inherit [m (-> any/c number? number?)]))
(class object% (super-new) (define/public (m x) x))
'pos
'neg)]
[d% (class c% (super-new) (inherit m) (define/public (f) (m 5)))])
(send (new d%) f)))
(test/spec-passed
'class/c-first-order-absent-1
'(contract (class/c (absent m)) object% 'pos 'neg))
@ -6889,6 +7025,24 @@
'pos
'neg))
(test/spec-passed
'class/c-first-order-opaque-absent-1
'(contract (class/c #:opaque (absent (field f))) object% 'pos 'neg))
(test/pos-blame
'class/c-first-order-opaque-absent-2
'(contract (class/c #:opaque (absent (field f)))
(class object% (super-new) (field [g 0]))
'pos
'neg))
(test/pos-blame
'class/c-first-order-opaque-absent-3
'(contract (class/c #:opaque (absent (field f g)))
(class object% (super-new) (field [g 0]))
'pos
'neg))
(test/spec-passed
'class/c-higher-order-init-1
'(let ([c% (contract (class/c (init [a number?]))