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

Escape "~" in tc-error/fields arguments

Browse Source 
Fixes issue #314
This commit is contained in:
Asumu Takikawa 2016-03-02 04:18:06 -05:00
parent 350a8bb74e
commit d23e05f2c3
2 changed files with 13 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
typed-racket-lib/typed-racket/utils/tc-utils.rkt
View File

@ -202,12 +202,14 @@ don't depend on any other portion of the system
;; Produce a type error using modern Racket error syntax.
;; Avoid using format directives in the `msg`, `more`, and `field`
;; strings in the rest argument (may cause unexpected errors)
(define (tc-error/fields msg
#:more [more #f]
;; strings in the rest argument because they will be escaped.
(define (tc-error/fields *msg
#:more [*more #f]
#:stx [stx (current-orig-stx)]
#:delayed? [delayed? #f]
. rst)
(define msg (escape-~ *msg))
(define more (and *more (escape-~ *more)))
(unless (even? (length rst))
(raise-argument-error
'tc-error/fields
@ -216,7 +218,7 @@ don't depend on any other portion of the system
(define-values (field-strs vals)
(for/fold ([field-strs null] [vals null])
([field+value (in-slice 2 rst)])
(define field (car field+value))
(define field (escape-~ (car field+value)))
(define value (cadr field+value))
(define field-strs*
(cons (format " ~a: ~~a" field) field-strs))
@ -229,6 +231,10 @@ don't depend on any other portion of the system
(apply tc-error/delayed #:stx stx final-msg (reverse vals))
(apply tc-error/stx stx final-msg (reverse vals))))
;; escape "~" to avoid breaking `format` down the line
(define (escape-~ str)
(regexp-replace #rx"~" str "~~"))
;; produce a type error, using the current syntax
(define (tc-error msg . rest)
(let* ([ostx (current-orig-stx)]

3
typed-racket-test/unit-tests/parse-type-tests.rkt
View File

@ -403,6 +403,9 @@
[FAIL (Unit (import bad) (export) String)]
[FAIL (Unit (import) (export bad) String)]
[(Sequenceof Any Any) (-seq Univ Univ)]
;; GH issue #314
[FAIL ~> #:msg "unbound"]
))
;; FIXME - add tests for parse-values-type, parse-tc-results