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

cs & io: fix exception type for "port closed"

Browse Source 
To be consistent with BC, it's an `exn:fail` exception, but not
`exn:fail:contract`.
This commit is contained in:
Matthew Flatt 2021-04-11 17:57:03 -06:00
parent a808eb042b
commit 4d6a23d1d5
3 changed files with 40 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/racket-test-core/tests/racket/port.rktl
View File

@ -941,7 +941,8 @@
(define (check proc)
(define p (open-input-bytes #"x"))
(close-input-port p)
(err/rt-test (proc p) exn:fail:contract? #rx"closed"))
(err/rt-test (proc p) exn:fail? #rx"closed")
(err/rt-test (proc p) (lambda (e) (not (exn:fail:contract? e)))))
(check read-byte)
(check peek-byte)
(check (lambda (p) (peek-byte p 10)))
@ -957,7 +958,8 @@
(define (check proc)
(define p (open-output-bytes))
(close-output-port p)
(err/rt-test (proc p) exn:fail:contract? #rx"closed"))
(err/rt-test (proc p) exn:fail? #rx"closed")
(err/rt-test (proc p) (lambda (e) (not (exn:fail:contract? e)))))
(check (lambda (p) (write-byte 10 p)))
(check (lambda (p) (write-bytes #"hello" p)))
(check (lambda (p) (write-char #\x p)))

35
racket/src/cs/schemified/io.scm
View File

@ -6057,13 +6057,24 @@
(begin
(unsafe-end-atomic)
(let ((input?_0 (core-input-port? cp_0)))
(let ((app_0
(if input?_0 "input port is closed" "output port is closed")))
(raise-arguments-error
who_0
app_0
(if input?_0 "input port" "output port")
cp_0))))
(raise
(let ((app_0
(let ((app_0 (symbol->string who_0)))
(let ((app_1
(if input?_0
"input port is closed"
"output port is closed")))
(let ((app_2
(if input?_0 "input port: " "output port: ")))
(string-append
app_0
": "
app_1
"\n "
app_2
(let ((app_3 (error-value->string-handler)))
(|#%app| app_3 cp_0 (error-print-width)))))))))
(|#%app| exn:fail app_0 (current-continuation-marks))))))
(void))))
(define 1/file-position
(|#%name|
@ -34229,11 +34240,11 @@
'subprocess
"(or/c (and/c output-port? file-stream-port?) #f 'stdout)"
stderr_0))
(let ((lr1319 unsafe-undefined)
(let ((lr1323 unsafe-undefined)
(group_0 unsafe-undefined)
(command_0 unsafe-undefined)
(exact/args_0 unsafe-undefined))
(set! lr1319
(set! lr1323
(call-with-values
(lambda ()
(if (path-string? group/command_0)
@ -34288,9 +34299,9 @@
((group_1 command_1 exact/args_1)
(vector group_1 command_1 exact/args_1))
(args (raise-binding-result-arity-error 3 args)))))
(set! group_0 (unsafe-vector*-ref lr1319 0))
(set! command_0 (unsafe-vector*-ref lr1319 1))
(set! exact/args_0 (unsafe-vector*-ref lr1319 2))
(set! group_0 (unsafe-vector*-ref lr1323 0))
(set! command_0 (unsafe-vector*-ref lr1323 1))
(set! exact/args_0 (unsafe-vector*-ref lr1323 2))
(call-with-values
(lambda ()
(if (if (pair? exact/args_0)

21
racket/src/io/port/check.rkt
View File

@ -15,11 +15,16 @@
(when (core-port-closed? cp)
(end-atomic)
(define input? (core-input-port? cp))
(raise-arguments-error who
(if input?
"input port is closed"
"output port is closed")
(if input?
"input port"
"output port")
cp)))
(raise
(exn:fail
(string-append (symbol->string who)
": "
(if input?
"input port is closed"
"output port is closed")
"\n "
(if input?
"input port: "
"output port: ")
((error-value->string-handler) cp (error-print-width)))
(current-continuation-marks)))))