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

fix is-a?/c opter

Browse Source
This commit is contained in:
Robby Findler 2013-04-26 09:28:46 -05:00
parent df4bf43ca3
commit ae5bde175d
3 changed files with 16 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/racket/contract/private/object.rkt
View File

@ -152,7 +152,7 @@
#:lifts lifts2
#:superlifts null
#:partials null
#:flat #'(is-a? cls-x val)
#:flat #'(is-a? val cls-x)
#:opt #f
#:stronger-ribs '()
#:chaperone #t

3
collects/racket/contract/private/opters.rkt
View File

@ -109,7 +109,8 @@
val
(raise-blame-error blame
val
"none of the branches of the or/c matched"))))]
'("none of the branches of the or/c matched" given: "~e")
val))))]
[(= (length hos) 1)
(with-syntax ([ho-ctc ho-ctc]
[val (opt/info-val opt/info)])

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

@ -12128,13 +12128,20 @@ so that propagation occurs.
(contract-eval `(class* object% (,i<%>) (super-new)))
#f))
(let ([i<%> (contract-eval '(interface ()))]
[c% (contract-eval '(class object% (super-new)))])
(test-flat-contract `(is-a?/c ,i<%>)
(contract-eval `(new (class* object% (,i<%>) (super-new))))
(begin
(contract-eval '(define flat-is-a-test<%> (interface ())))
(contract-eval '(define flat-is-a-test% (class object% (super-new))))
(test-flat-contract `(is-a?/c flat-is-a-test<%>)
(contract-eval `(new (class* object% (flat-is-a-test<%>) (super-new))))
(contract-eval '(new object%)))
(test-flat-contract `(is-a?/c ,c%)
(contract-eval `(new ,c%))
(test-flat-contract `(is-a?/c flat-is-a-test%)
(contract-eval `(new flat-is-a-test%))
(contract-eval '(new object%)))
(test-flat-contract `(or/c #f (is-a?/c flat-is-a-test<%>))
(contract-eval `(new (class* object% (flat-is-a-test<%>) (super-new))))
(contract-eval '(new object%)))
(test-flat-contract `(or/c #f (is-a?/c flat-is-a-test%))
(contract-eval `(new flat-is-a-test%))
(contract-eval '(new object%))))
(test-flat-contract '(listof boolean?) (list #t #f) (list #f 3 #t))