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

improve error message in certain tricky case when keywords are involved

Browse Source
This commit is contained in:
Robby Findler 2015-01-04 15:00:22 -06:00
parent 95dcee18c7
commit 2cd8e620d4
2 changed files with 31 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
pkgs/racket-test/tests/racket/contract/class.rkt
View File

@ -2459,7 +2459,22 @@
'pos 'neg))]) 'pos 'neg))])
(object=? (send o get-this) o)) (object=? (send o get-this) o))
#t) #t)
(test/spec-passed/result
'keywords-in-error-message1
'(with-handlers ([exn:fail:contract:blame? (λ (x)
(define m
(regexp-match #rx"given: ([^\n]*)" (exn-message x)))
(and m (list-ref m 1)))])
(send (new (contract (class/c [save-file (-> any/c void?)])
(class object%
(define/public (save-file #:unscaled? [x 1])
(void))
(super-new))
'pos 'neg))
save-file #:unscaled? #t))
"#:unscaled?")
;; this test case won't pass until the internal-ctc ;; this test case won't pass until the internal-ctc
;; call is delayed in the new class/c projections ;; call is delayed in the new class/c projections
;; (but otherwise it passes) ;; (but otherwise it passes)

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

@ -420,7 +420,21 @@
(if (and (null? req-kwd) (null? opt-kwd)) (if (and (null? req-kwd) (null? opt-kwd))
(λ (kwds kwd-args . args) (λ (kwds kwd-args . args)
(raise-blame-error (blame-swap blame) val (raise-blame-error (blame-swap blame) val
'(expected: "no keywords"))) (list 'expected:
"no keywords"
'given:
(apply
string-append
(let loop ([kwds kwds])
(cond
[(null? kwds) '()]
[(null? (cdr kwds))
(list "#:" (keyword->string (car kwds)))]
[else
(list* "#:"
(keyword->string (car kwds))
" "
(loop (cdr kwds)))]))))))
(λ (kwds kwd-args . args) (λ (kwds kwd-args . args)
(with-continuation-mark (with-continuation-mark
contract-continuation-mark-key blame contract-continuation-mark-key blame