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

fix bug in val-first version of or/c

Browse Source 
It didn't follow the val-first protocol properly and
ended up losing the neg party
This commit is contained in:
Robby Findler 2014-04-05 07:33:42 -05:00
parent c4f497bf2b
commit a205cb2d0c
2 changed files with 32 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
pkgs/racket-pkgs/racket-test/tests/racket/contract/or-and.rkt
View File

@ -219,4 +219,23 @@
(test/pos-blame (test/pos-blame
'contract-flat2 'contract-flat2
'(contract not #t 'pos 'neg))) '(contract not #t 'pos 'neg))
(test/neg-blame
'ho-or/c-val-first1
'((contract (-> (or/c (-> number?)
(-> number? number?))
number?)
(λ (x) 1)
'pos 'neg)
(lambda (x y z) 1)))
(test/neg-blame
'ho-or/c-val-first2
'((contract (-> (or/c (-> number? number?)
(-> number? number?))
number?)
(λ (x) 1)
'pos 'neg)
(lambda (x) 1))))

22
racket/collects/racket/contract/private/misc.rkt
View File

@ -295,18 +295,20 @@
[candidate-c-proj [candidate-c-proj
((candidate-c-proj blame-w-context) val)] ((candidate-c-proj blame-w-context) val)]
[else [else
(raise-blame-error blame val (λ (neg-party)
'("none of the branches of the or/c matched" given: "~e") (raise-blame-error blame val #:missing-party neg-party
val)])] '("none of the branches of the or/c matched" given: "~e")
val))])]
[((car checks) val) [((car checks) val)
(if candidate-c-proj (if candidate-c-proj
(raise-blame-error blame val (λ (neg-party)
'("two of the clauses in the or/c might both match: ~s and ~s" (raise-blame-error blame val #:missing-party neg-party
given: '("two of the clauses in the or/c might both match: ~s and ~s"
"~e") given:
(contract-name candidate-contract) "~e")
(contract-name (car contracts)) (contract-name candidate-contract)
val) (contract-name (car contracts))
val))
(loop (cdr checks) (loop (cdr checks)
(cdr c-projs) (cdr c-projs)
(cdr contracts) (cdr contracts)