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

View File

@ -199,6 +199,12 @@
(string->jsexpr @T{ falsetto }) =error> "string->jsexpr:" (string->jsexpr @T{ falsetto }) =error> "string->jsexpr:"
(string->jsexpr @T{ nullity }) =error> "string->jsexpr:" (string->jsexpr @T{ nullity }) =error> "string->jsexpr:"
(string->jsexpr @T{ nulliparous }) =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) (test do (pred-tests)

View File

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