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 #:lifts lifts2
#:superlifts null #:superlifts null
#:partials null #:partials null
#:flat #'(is-a? cls-x val) #:flat #'(is-a? val cls-x)
#:opt #f #:opt #f
#:stronger-ribs '() #:stronger-ribs '()
#:chaperone #t #:chaperone #t

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

@ -109,7 +109,8 @@
val val
(raise-blame-error blame (raise-blame-error blame
val 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) [(= (length hos) 1)
(with-syntax ([ho-ctc ho-ctc] (with-syntax ([ho-ctc ho-ctc]
[val (opt/info-val opt/info)]) [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))) (contract-eval `(class* object% (,i<%>) (super-new)))
#f)) #f))
(let ([i<%> (contract-eval '(interface ()))] (begin
[c% (contract-eval '(class object% (super-new)))]) (contract-eval '(define flat-is-a-test<%> (interface ())))
(test-flat-contract `(is-a?/c ,i<%>) (contract-eval '(define flat-is-a-test% (class object% (super-new))))
(contract-eval `(new (class* object% (,i<%>) (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%))) (contract-eval '(new object%)))
(test-flat-contract `(is-a?/c ,c%) (test-flat-contract `(is-a?/c flat-is-a-test%)
(contract-eval `(new ,c%)) (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%)))) (contract-eval '(new object%))))
(test-flat-contract '(listof boolean?) (list #t #f) (list #f 3 #t)) (test-flat-contract '(listof boolean?) (list #t #f) (list #f 3 #t))