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

fix the contract context messages for the case of ->*'s #:rest arguments

Browse Source
This commit is contained in:
Robby Findler 2012-05-25 09:13:35 -05:00
parent eeb3da0c23
commit 7156b0391b
2 changed files with 31 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/racket/contract/private/arrow.rkt
View File

@ -476,8 +476,11 @@ v4 todo:
(for/list ([dom (in-list doms-proj)]
[n (in-naturals 1)])
(dom (blame-add-context orig-blame
(format "the ~a argument of"
(n->th n))
(if (and has-rest?
(n . > . dom-length))
"the rest argument of"
(format "the ~a argument of"
(n->th n)))
#:swap? #t))))
(define partial-optional-doms
(for/list ([dom (in-list doms-optional-proj)]

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

@ -12728,7 +12728,7 @@ so that propagation occurs.
'neg)
#f)))
(ctest '("the range of")
(ctest '("the range of")
extract-context-lines
(λ () ((contract (->d ([x integer?]) [y integer?])
(λ (x) #f)
@ -12837,6 +12837,31 @@ so that propagation occurs.
0)
1)))
(ctest '("an element of" "the rest argument of")
extract-context-lines
(λ ()
((contract (->* () #:rest (listof number?) number?)
+
'pos 'neg)
1 "a")))
(ctest '("the 2nd argument of")
extract-context-lines
(λ ()
((contract (->* (number? number?) #:rest (listof number?) number?)
+
'pos 'neg)
1 "a")))
(ctest '("an element of" "the rest argument of")
extract-context-lines
(λ ()
((contract (->* (number?) #:rest (listof number?) number?)
+
'pos 'neg)
1 "a")))
(let* ([blame-pos (contract-eval '(make-blame #'here #f (λ () 'integer?) 'positive 'negative #t))]
[blame-neg (contract-eval `(blame-swap ,blame-pos))])
(ctest "something ~a" blame-fmt->-string ,blame-neg "something ~a")