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

place* throw error on closed port

Browse Source
This commit is contained in:
Kevin Tew 2011-09-16 13:03:58 -06:00
parent 443434fd01
commit a605a97132
4 changed files with 21 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/tests/racket/place-ports.rkt
View File

@ -7,6 +7,16 @@
(define (main)
(test-exn
"using a closed port with place*"
(lambda (x) (void))
(let ()
(define op (open-output-bytes))
(call-with-output-file "foo.foo" #:exists 'replace (lambda (op)
(close-output-port op)
(let-values ([(p pin pout perr) (place* #:out op ch (printf "Hello3\n"))])
(place-wait p))))))
(place-wait (place ch (printf "Hello1\n")))
(place-wait (place ch (eprintf "Hello2\n")))
(place-wait (place ch (printf "~a\n" (read)))) ; #<eof>

6
src/racket/src/place.c
View File

@ -349,6 +349,8 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
int errorno;
if (SCHEME_TRUEP(in_arg)) {
if (scheme_port_closed_p(in_arg))
scheme_arg_mismatch("dynamic-place", "port is closed: ", in_arg);
scheme_get_port_file_descriptor(in_arg, &tmpfd);
tmpfd = scheme_dup_file(tmpfd);
if (tmpfd == -1) {
@ -365,6 +367,8 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
}
if (SCHEME_TRUEP(out_arg)) {
if (scheme_port_closed_p(out_arg))
scheme_arg_mismatch("dynamic-place", "port is closed: ", out_arg);
scheme_get_port_file_descriptor(out_arg, &tmpfd);
tmpfd = scheme_dup_file(tmpfd);
if (tmpfd == -1) {
@ -381,6 +385,8 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
}
if (SCHEME_TRUEP(err_arg)) {
if (scheme_port_closed_p(err_arg))
scheme_arg_mismatch("dynamic-place", "port is closed: ", err_arg);
scheme_get_port_file_descriptor(err_arg, &tmpfd);
tmpfd = scheme_dup_file(tmpfd);
if (tmpfd == -1) {

4
src/racket/src/portfun.c
View File

@ -2182,6 +2182,10 @@ static Scheme_Object *port_closed_p (int argc, Scheme_Object *argv[])
}
}
intptr_t scheme_port_closed_p (Scheme_Object *port) {
return (port_closed_p(1, &port) == scheme_false) ? 0 : 1;
}
static Scheme_Object *current_input_port(int argc, Scheme_Object *argv[])
{
return scheme_param_config("current-input-port", scheme_make_integer(MZCONFIG_INPUT_PORT),

1
src/racket/src/schpriv.h
View File

@ -3495,6 +3495,7 @@ int scheme_byte_ready_or_user_port_ready(Scheme_Object *p, Scheme_Schedule_Info
int scheme_pipe_char_count(Scheme_Object *p);
void scheme_alloc_global_fdset();
Scheme_Object *scheme_port_name(Scheme_Object *p);
intptr_t scheme_port_closed_p (Scheme_Object *port);
#define CURRENT_INPUT_PORT(config) scheme_get_param(config, MZCONFIG_INPUT_PORT)
#define CURRENT_OUTPUT_PORT(config) scheme_get_param(config, MZCONFIG_OUTPUT_PORT)