try to avoid blocking once we are committed to an error

This commit is contained in:
Robby Findler 2021-05-12 19:40:07 -05:00 committed by Matthew Flatt
parent 3fce07c8b5
commit 40cd1ea083
2 changed files with 12 additions and 5 deletions
pkgs/racket-test/tests/json
racket/collects/json

View File

@ -199,6 +199,12 @@
(string->jsexpr @T{ falsetto }) =error> "string->jsexpr:"
(string->jsexpr @T{ nullity }) =error> "string->jsexpr:"
(string->jsexpr @T{ nulliparous }) =error> "string->jsexpr:"
(let ()
(define-values (in out) (make-pipe))
(display "started" out)
(flush-output out)
(read-json in))
=error> #rx"read-json: bad input starting #\"started\""
))
(test do (pred-tests)

View File

@ -466,16 +466,17 @@
[else (bad-input)]))
;;
(define (bad-input [prefix #""] #:eof? [eof? #f])
(define bstr (peek-bytes (sub1 (error-print-width)) 0 i))
(if (or (and (eof-object? bstr) (equal? prefix #""))
(define bstr (make-bytes (sub1 (error-print-width))))
(define bytes-read (peek-bytes-avail! bstr 0 #f i))
(if (or (and (eof-object? bytes-read) (equal? prefix #""))
eof?)
(err (string-append "unexpected end-of-file"
(if (equal? prefix #"")
""
(format "after ~e" prefix))))
(err (format "bad input starting ~e" (bytes-append prefix (if (eof-object? bstr)
#""
bstr))))))
(err (format "bad input starting ~e" (bytes-append prefix (if (number? bytes-read)
(subbytes bstr 0 bytes-read)
#""))))))
;;
(read-json #t))