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
'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 blame-w-context) val)]
[else
(raise-blame-error blame val
'("none of the branches of the or/c matched" given: "~e")
val)])]
(λ (neg-party)
(raise-blame-error blame val #:missing-party neg-party
'("none of the branches of the or/c matched" given: "~e")
val))])]
[((car checks) val)
(if candidate-c-proj
(raise-blame-error blame val
'("two of the clauses in the or/c might both match: ~s and ~s"
given:
"~e")
(contract-name candidate-contract)
(contract-name (car contracts))
val)
(λ (neg-party)
(raise-blame-error blame val #:missing-party neg-party
'("two of the clauses in the or/c might both match: ~s and ~s"
given:
"~e")
(contract-name candidate-contract)
(contract-name (car contracts))
val))
(loop (cdr checks)
(cdr c-projs)
(cdr contracts)