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

generalizations to `subprocess' & company

Browse Source 
- allow byte strings in more places
  - allow stderr spec to be 'stdout to redirect stderr to stdout
 Closes PR 11711
This commit is contained in:
Matthew Flatt 2011-02-19 08:30:34 -07:00
parent 9325fe0f25
commit b4056373be
4 changed files with 236 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
collects/mzlib/process.rkt
View File

@ -1,4 +1,4 @@
#lang mzscheme #lang racket/base
(provide process (provide process
process* process*
process/ports process/ports
@ -33,15 +33,20 @@
(format "~a: don't know what shell to use for platform: " who) (format "~a: don't know what shell to use for platform: " who)
(system-type))])) (system-type))]))
(define (if-stream-out p) (define (if-stream-out who p [sym-ok? #f])
(cond [(or (not p) (file-stream-port? p)) p] (cond [(and sym-ok? (eq? p 'stdout)) p]
[(or (not p) (and (output-port? p) (file-stream-port? p))) p]
[(output-port? p) #f] [(output-port? p) #f]
[else (raise-type-error 'subprocess "output port" p)])) [else (raise-type-error who
(if sym-ok?
"output port, #f, or 'stdout"
"output port or #f")
p)]))
(define (if-stream-in p) (define (if-stream-in who p)
(cond [(or (not p) (file-stream-port? p)) p] (cond [(or (not p) (and (input-port? p) (file-stream-port? p))) p]
[(input-port? p) #f] [(input-port? p) #f]
[else (raise-type-error 'subprocess "input port" p)])) [else (raise-type-error who "input port or #f" p)]))
(define (streamify-in cin in ready-for-break) (define (streamify-in cin in ready-for-break)
(if (and cin (not (file-stream-port? cin))) (if (and cin (not (file-stream-port? cin)))
@ -58,7 +63,9 @@
in)) in))
(define (streamify-out cout out) (define (streamify-out cout out)
(if (and cout (not (file-stream-port? cout))) (if (and cout
(not (eq? cout 'stdout))
(not (file-stream-port? cout)))
(thread (lambda () (thread (lambda ()
(dynamic-wind (dynamic-wind
void void
@ -66,14 +73,42 @@
(lambda () (close-input-port out))))) (lambda () (close-input-port out)))))
out)) out))
(define (check-exe who exe)
(unless (or (path-string? exe)
(eq? exe 'exact))
(raise-type-error who "path, string, or 'exact" exe))
exe)
(define (check-args who exe args)
(cond
[(eq? exe 'exact)
(unless (and (= 1 (length args))
(string? (car args))
(path-string? (car args)))
(raise-mismatch-error "expected a single string argument with 'exact, given: "
args))]
[else
(for ([s (in-list args)])
(unless (or (path-string? s)
(and (bytes? s)
(for/and ([b (in-bytes s)]) (positive? b))))
(raise-type-error who "path, string, or byte string (no with nuls)" s)))])
args)
(define (check-command who str)
(unless (or (string? str)
(bytes? str))
(raise-type-error who "string or byte string" str)))
;; Old-style functions: ---------------------------------------- ;; Old-style functions: ----------------------------------------
(define (process*/ports cout cin cerr exe . args) (define (do-process*/ports who cout cin cerr exe . args)
(let-values ([(subp out in err) (apply subprocess (let-values ([(subp out in err) (apply subprocess
(if-stream-out cout) (if-stream-out who cout)
(if-stream-in cin) (if-stream-in who cin)
(if-stream-out cerr) (if-stream-out who cerr #t)
exe args)] (check-exe who exe)
(check-args who exe args))]
[(it-ready) (make-semaphore)]) [(it-ready) (make-semaphore)])
(let ([so (streamify-out cout out)] (let ([so (streamify-out cout out)]
[si (streamify-in cin in (lambda (ok?) [si (streamify-in cin in (lambda (ok?)
@ -121,27 +156,32 @@
(aport se) (aport se)
control))))) control)))))
(define (process*/ports cout cin cerr exe . args)
(apply do-process*/ports 'process*/ports cout cin cerr exe args))
(define (process/ports out in err str) (define (process/ports out in err str)
(apply process*/ports out in err (shell-path/args 'process/ports str))) (apply do-process*/ports 'process/ports out in err (shell-path/args 'process/ports str)))
(define (process* exe . args) (define (process* exe . args)
(apply process*/ports #f #f #f exe args)) (apply do-process*/ports 'process* #f #f #f exe args))
(define (process str) (define (process str)
(apply process* (shell-path/args 'process str))) (check-command 'process str)
(apply do-process*/ports 'process #f #f #f (shell-path/args 'process str)))
;; Note: these always use current ports ;; Note: these always use current ports
(define (system*/exit-code exe . args) (define (do-system*/exit-code who exe . args)
(let ([cout (current-output-port)] (let ([cout (current-output-port)]
[cin (current-input-port)] [cin (current-input-port)]
[cerr (current-error-port)] [cerr (current-error-port)]
[it-ready (make-semaphore)]) [it-ready (make-semaphore)])
(let-values ([(subp out in err) (let-values ([(subp out in err)
(apply subprocess (apply subprocess
(if-stream-out cout) (if-stream-out who cout)
(if-stream-in cin) (if-stream-in who cin)
(if-stream-out cerr) (if-stream-out who cerr #t)
exe args)]) (check-exe who exe)
(check-args who exe args))])
(let ([ot (streamify-out cout out)] (let ([ot (streamify-out cout out)]
[it (streamify-in cin in (lambda (ok?) [it (streamify-in cin in (lambda (ok?)
(if ok? (if ok?
@ -161,11 +201,16 @@
(when in (close-output-port in))) (when in (close-output-port in)))
(subprocess-status subp)))) (subprocess-status subp))))
(define (system*/exit-code exe . args)
(apply do-system*/exit-code 'system*/exit-code exe args))
(define (system* exe . args) (define (system* exe . args)
(zero? (apply system*/exit-code exe args))) (zero? (apply do-system*/exit-code 'system* exe args)))
(define (system str) (define (system str)
(apply system* (shell-path/args 'system str))) (check-command 'system str)
(zero? (apply do-system*/exit-code 'system (shell-path/args 'system str))))
(define (system/exit-code str) (define (system/exit-code str)
(apply system*/exit-code (shell-path/args 'system/exit-code str))) (check-command 'system/exit-code str)
(apply do-system*/exit-code 'system/exit-code (shell-path/args 'system/exit-code str)))

46
collects/scribblings/reference/subprocess.scrbl
View File

@ -6,9 +6,9 @@
@defproc*[([(subprocess [stdout (or/c (and/c output-port? file-stream-port?) #f)] @defproc*[([(subprocess [stdout (or/c (and/c output-port? file-stream-port?) #f)]
[stdin (or/c (and/c input-port? file-stream-port?) #f)] [stdin (or/c (and/c input-port? file-stream-port?) #f)]
[stderr (or/c (and/c output-port? file-stream-port?) #f)] [stderr (or/c (and/c output-port? file-stream-port?) #f 'stdout)]
[command path-string?] [command path-string?]
[arg string?] ...) [arg (or/c path? string? bytes?)] ...)
(values subprocess? (values subprocess?
(or/c (and/c input-port? file-stream-port?) #f) (or/c (and/c input-port? file-stream-port?) #f)
(or/c (and/c output-port? file-stream-port?) #f) (or/c (and/c output-port? file-stream-port?) #f)
@ -30,8 +30,11 @@ Creates a new process in the underlying operating system to execute
The @racket[command] argument is a path to a program executable, and The @racket[command] argument is a path to a program executable, and
the @racket[arg]s are command-line arguments for the program. Under the @racket[arg]s are command-line arguments for the program. Under
Unix and Mac OS X, command-line arguments are passed as byte strings Unix and Mac OS X, command-line arguments are passed as byte strings,
using the current locale's encoding (see @secref["encodings"]). and string @racket[args] are converted using the current locale's
encoding (see @secref["encodings"]). Under Windows, command-line
arguments are passed as strings, and bytes strings are converted using
UTF-8.
Under Windows, the first @racket[arg] can be replaced with Under Windows, the first @racket[arg] can be replaced with
@indexed-racket['exact], which triggers a Windows-specific behavior: @indexed-racket['exact], which triggers a Windows-specific behavior:
@ -46,12 +49,15 @@ the @exnraise[exn:fail:contract].
search for ``command line parsing'' at search for ``command line parsing'' at
@tt{http://msdn.microsoft.com/}.} @tt{http://msdn.microsoft.com/}.}
Unless it is @racket[#f], @racket[stdout] is used for the launched When provided as a port, @racket[stdout] is used for the launched
process's standard output, @racket[stdin] is used for the process's process's standard output, @racket[stdin] is used for the process's
standard input, and @racket[stderr] is used for the process's standard standard input, and @racket[stderr] is used for the process's standard
error. All provided ports must be file-stream ports. Any of the ports error. All provided ports must be file-stream ports. Any of the ports
can be @racket[#f], in which case a system pipe is created and can be @racket[#f], in which case a system pipe is created and
returned by @racket[subprocess]. For each port that is provided, no returned by @racket[subprocess]. The @racket[stderr] argument can be
@racket['stdout], in which case the same file-stream port or system pipe
that is supplied as standard output is also used for standard error.
For each port or @racket['stdout] that is provided, no
pipe is created and the corresponding returned value is @racket[#f]. pipe is created and the corresponding returned value is @racket[#f].
The @racket[subprocess] procedure returns four values: The @racket[subprocess] procedure returns four values:
@ -67,7 +73,7 @@ The @racket[subprocess] procedure returns four values:
@racket[#f] if @racket[stdin-input-port] was a port;} @racket[#f] if @racket[stdin-input-port] was a port;}
@item{an input port piped from the process's standard error, or @item{an input port piped from the process's standard error, or
@racket[#f] if @racket[stderr-output-port] was a port.} @racket[#f] if @racket[stderr-output-port] was a port or @racket['stdout].}
] ]
@ -311,12 +317,12 @@ real process ID).}
@note-lib[racket/system] @note-lib[racket/system]
@defproc[(system [command string?]) boolean?]{ @defproc[(system [command (or/c string? bytes?)]) boolean?]{
Executes a Unix, Mac OS X, or Windows shell command synchronously Executes a Unix, Mac OS X, or Windows shell command synchronously
(i.e., the call to @racket[system] does not return until the (i.e., the call to @racket[system] does not return until the
subprocess has ended). The @racket[command] argument is a string subprocess has ended). The @racket[command] argument is a string
containing no nul characters. If the command succeeds, the return or byte string containing no nul characters. If the command succeeds, the return
value is @racket[#t], @racket[#f] otherwise. value is @racket[#t], @racket[#f] otherwise.
See also @racket[current-subprocess-custodian-mode] and See also @racket[current-subprocess-custodian-mode] and
@ -324,7 +330,7 @@ See also @racket[current-subprocess-custodian-mode] and
implement @racket[system].} implement @racket[system].}
@defproc*[([(system* [command path-string?] [arg string?] ...) boolean?] @defproc*[([(system* [command path-string?] [arg (or/c path? string? bytes?)] ...) boolean?]
[(system* [command path-string?] [exact 'exact] [arg string?]) boolean?])]{ [(system* [command path-string?] [exact 'exact] [arg string?]) boolean?])]{
Like @racket[system], except that @racket[command] is a filename that Like @racket[system], except that @racket[command] is a filename that
@ -344,7 +350,7 @@ Like @racket[system], except that the result is the exit code returned
by the subprocess. A @racket[0] result normally indicates success.} by the subprocess. A @racket[0] result normally indicates success.}
@defproc*[([(system*/exit-code [command path-string?] [arg string?] ...) (integer-in 0 255)] @defproc*[([(system*/exit-code [command path-string?] [arg (or/c path? string? bytes?)] ...) (integer-in 0 255)]
[(system*/exit-code [command path-string?] [exact 'exact] [arg string?]) (integer-in 0 255)])]{ [(system*/exit-code [command path-string?] [exact 'exact] [arg string?]) (integer-in 0 255)])]{
Like @racket[system*], but returns the exit code like Like @racket[system*], but returns the exit code like
@ -420,7 +426,7 @@ implement @racket[process]. In particular, the @racket['interrupt] and
of a single process.} of a single process.}
@defproc*[([(process* [command path-string?] [arg string?] ...) list?] @defproc*[([(process* [command path-string?] [arg (or/c path? string? bytes?)] ...) list?]
[(process* [command path-string?] [exact 'exact] [arg string?]) list?])]{ [(process* [command path-string?] [exact 'exact] [arg string?]) list?])]{
Like @racket[process], except that @racket[command] is a filename that Like @racket[process], except that @racket[command] is a filename that
@ -431,7 +437,7 @@ replaced with @racket['exact].}
@defproc[(process/ports [out (or/c #f output-port?)] @defproc[(process/ports [out (or/c #f output-port?)]
[in (or/c #f input-port?)] [in (or/c #f input-port?)]
[error-out (or/c #f output-port?)] [error-out (or/c #f output-port? 'stdout)]
[command string?]) [command string?])
list?]{ list?]{
@ -439,19 +445,21 @@ Like @racket[process], except that @racket[out] is used for the
process's standard output, @racket[in] is used for the process's process's standard output, @racket[in] is used for the process's
standard input, and @racket[error-out] is used for the process's standard input, and @racket[error-out] is used for the process's
standard error. Any of the ports can be @racket[#f], in which case a standard error. Any of the ports can be @racket[#f], in which case a
system pipe is created and returned, as in @racket[process]. For each system pipe is created and returned, as in @racket[process]. If
port that is provided, no pipe is created, and the corresponding value @racket[error-out] is @racket['stdout], then standard error is
in the returned list is @racket[#f].} redirected to standard output. For each port or @racket['stdout] that
is provided, no pipe is created, and the corresponding value in the
returned list is @racket[#f].}
@defproc*[([(process*/ports [out (or/c #f output-port?)] @defproc*[([(process*/ports [out (or/c #f output-port?)]
[in (or/c #f input-port?)] [in (or/c #f input-port?)]
[error-out (or/c #f output-port?)] [error-out (or/c #f output-port? 'stdout)]
[command path-string?] [command path-string?]
[arg string?] ...) [arg (or/c path? string? bytes?)] ...)
list?] list?]
[(process*/ports [out (or/c #f output-port?)] [(process*/ports [out (or/c #f output-port?)]
[in (or/c #f input-port?)] [in (or/c #f input-port?)]
[error-out (or/c #f output-port?)] [error-out (or/c #f output-port? 'stdout)]
[command path-string?] [command path-string?]
[exact 'exact] [exact 'exact]
[arg string?]) [arg string?])

92
collects/tests/racket/subprocess.rktl
View File

@ -37,7 +37,8 @@
;; Generate output to stderr as well as stdout ;; Generate output to stderr as well as stdout
(let ([p (process* cat "-" "nosuchfile")]) (define (nosuchfile-test dash nosuchfile)
(let ([p (process* cat dash nosuchfile)])
(fprintf (cadr p) "Hello\n") (fprintf (cadr p) "Hello\n")
(close-output-port (cadr p)) (close-output-port (cadr p))
(test "Hello" read-line (car p)) (test "Hello" read-line (car p))
@ -50,7 +51,29 @@
(test 'done-error (list-ref p 4) 'status) (test 'done-error (list-ref p 4) 'status)
(close-input-port (car p)) (close-input-port (car p))
(close-input-port (cadddr p))) (close-input-port (cadddr p))))
(nosuchfile-test "-" "nosuchfile")
(nosuchfile-test #"-" (string->path "nosuchfile"))
(nosuchfile-test (string->path "-") "nosuchfile")
;; Redirect stderr to stdout:
(let ([p (process*/ports #f #f 'stdout cat "-" "nosuchfile")])
(test #t file-stream-port? (car p))
(test #t file-stream-port? (cadr p))
(test #f cadddr p)
(fprintf (cadr p) "Hello\n")
(close-output-port (cadr p))
(test "Hello" read-line (car p))
(test '("nosuchfile")
regexp-match "nosuchfile" (read-line (car p)))
(test eof read-line (car p))
((list-ref p 4) 'wait)
(test 'done-error (list-ref p 4) 'status)
(close-input-port (car p)))
;; Supply file for stdout ;; Supply file for stdout
@ -73,8 +96,9 @@
;; Supply file for stdout & stderr, only stdout writes ;; Supply file for stdout & stderr, only stdout writes
(define (stderr-to-stdout-test stderr-filter)
(let ([f (open-output-file tmpfile #:exists 'truncate/replace)]) (let ([f (open-output-file tmpfile #:exists 'truncate/replace)])
(let ([p (process*/ports f #f f cat)]) (let ([p (process*/ports f #f (stderr-filter f) cat)])
(test #f car p) (test #f car p)
(test #f cadddr p) (test #f cadddr p)
@ -86,7 +110,9 @@
(close-output-port f) (close-output-port f)
(test 6 file-size tmpfile) (test 6 file-size tmpfile)
(test 'Hello with-input-from-file tmpfile read))) (test 'Hello with-input-from-file tmpfile read))))
(stderr-to-stdout-test values)
(stderr-to-stdout-test (lambda (x) 'stdout))
;; Supply file for stderr ;; Supply file for stderr
@ -246,6 +272,56 @@
(test f2 f2 f2) (test f2 f2 f2)
(test f2 f f))) (test f2 f f)))
;; system* ------------------------------------------------------
(let ([out (open-output-string)])
(test #t 'system*
(parameterize ([current-input-port (open-input-string "Hi\n")]
[current-output-port out])
(system* cat "-")))
(test "Hi\n" get-output-string out))
(let ([out (open-output-string)])
(test 0 'system*/exit-code
(parameterize ([current-input-port (open-input-string "Hi\n")]
[current-output-port out])
(system*/exit-code cat "-")))
(test "Hi\n" get-output-string out))
;; shells ------------------------------------------------------
(let ([go
(lambda (path->string)
(let ([p (process (path->string cat))])
(fprintf (cadr p) "Hi\n")
(close-output-port (cadr p))
(test "Hi" read-line (car p) 'any)
(close-input-port (car p))
(close-input-port (cadddr p))
(test 'done-ok (list-ref p 4) 'status)))])
(go path->string)
(go path->bytes))
(let ([p (process/ports #f (open-input-string "Hi\n") 'stdout (path->string cat))])
(test "Hi" read-line (car p) 'any)
(close-input-port (car p))
(test #f cadddr p)
(test 'done-ok (list-ref p 4) 'status))
(let ([out (open-output-string)])
(test #t 'system
(parameterize ([current-input-port (open-input-string "Hi\n")]
[current-output-port out])
(system (path->string cat))))
(test "Hi\n" get-output-string out))
(let ([out (open-output-string)])
(test 0 'system
(parameterize ([current-input-port (open-input-string "Hi\n")]
[current-output-port out])
(system/exit-code (path->string cat))))
(test "Hi\n" get-output-string out))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; nested tests ;;; nested tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -310,9 +386,10 @@
(equal? (equal?
(list (number->string sub-pid)) (list (number->string sub-pid))
(regexp-match (regexp-match
(format "(?m:^~a(?=[^0-9]))" sub-pid) (format "(?m:^ *~a(?=[^0-9]))" sub-pid)
(let ([s (open-output-string)]) (let ([s (open-output-string)])
(parameterize ([current-output-port s]) (parameterize ([current-output-port s]
[current-input-port (open-input-string "")])
(system (format "ps x"))) (system (format "ps x")))
(get-output-string s)))))]) (get-output-string s)))))])
(let ([sub-pid (read (car l))]) (let ([sub-pid (read (car l))])
@ -323,7 +400,8 @@
(test 'done-error (list-ref l 4) 'status) (test 'done-error (list-ref l 4) 'status)
(test post-shutdown? running? sub-pid) (test post-shutdown? running? sub-pid)
(when post-shutdown? (when post-shutdown?
(system (format "kill ~a" sub-pid))))))]) (parameterize ([current-input-port (open-input-string "")])
(system (format "kill ~a" sub-pid)))))))])
(try #t) (try #t)
(try #f))) (try #f)))

37
src/racket/src/port.c
View File

@ -7782,6 +7782,7 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
Scheme_Object *inport; Scheme_Object *inport;
Scheme_Object *outport; Scheme_Object *outport;
Scheme_Object *errport; Scheme_Object *errport;
int stderr_is_stdout = 0;
Scheme_Object *a[4]; Scheme_Object *a[4];
Scheme_Subprocess *subproc; Scheme_Subprocess *subproc;
Scheme_Object *cust_mode; Scheme_Object *cust_mode;
@ -7817,7 +7818,7 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
mzCOPY_FILE_HANDLE(from_subprocess, 1); mzCOPY_FILE_HANDLE(from_subprocess, 1);
#endif #endif
} else } else
scheme_wrong_type(name, "file-stream-output-port", 0, c, args); scheme_wrong_type(name, "file-stream-output-port or #f", 0, c, args);
} else } else
outport = NULL; outport = NULL;
@ -7841,11 +7842,15 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
mzCOPY_FILE_HANDLE(to_subprocess, 0); mzCOPY_FILE_HANDLE(to_subprocess, 0);
#endif #endif
} else } else
scheme_wrong_type(name, "file-stream-input-port", 1, c, args); scheme_wrong_type(name, "file-stream-input-port or #f", 1, c, args);
} else } else
inport = NULL; inport = NULL;
if (SCHEME_TRUEP(args[2])) { if (SCHEME_SYMBOLP(args[2]) && !SCHEME_SYM_WEIRDP(args[2])
&& !strcmp("stdout", SCHEME_SYM_VAL(args[2]))) {
errport = NULL;
stderr_is_stdout = 1;
} else if (SCHEME_TRUEP(args[2])) {
errport = args[2]; errport = args[2];
if (SCHEME_OUTPUT_PORTP(errport) && SCHEME_TRUEP(scheme_file_stream_port_p(1, &errport))) { if (SCHEME_OUTPUT_PORTP(errport) && SCHEME_TRUEP(scheme_file_stream_port_p(1, &errport))) {
#ifdef PROCESS_FUNCTION #ifdef PROCESS_FUNCTION
@ -7865,7 +7870,7 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
mzCOPY_FILE_HANDLE(err_subprocess, 1); mzCOPY_FILE_HANDLE(err_subprocess, 1);
#endif #endif
} else } else
scheme_wrong_type(name, "file-stream-output-port", 2, c, args); scheme_wrong_type(name, "file-stream-output-port, #f, or 'stdout", 2, c, args);
} else } else
errport = NULL; errport = NULL;
@ -7913,11 +7918,16 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
#endif #endif
} else { } else {
for (i = 4; i < c; i++) { for (i = 4; i < c; i++) {
if (!SCHEME_CHAR_STRINGP(args[i]) || scheme_any_string_has_null(args[i])) if (((!SCHEME_CHAR_STRINGP(args[i]) && !SCHEME_BYTE_STRINGP(args[i]))
scheme_wrong_type(name, CHAR_STRING_W_NO_NULLS, i, c, args); || scheme_any_string_has_null(args[i]))
&& !SCHEME_PATHP(args[i]))
scheme_wrong_type(name, "path, string, or byte string (without nuls)", i, c, args);
{ {
Scheme_Object *bs; Scheme_Object *bs;
bs = scheme_char_string_to_byte_string_locale(args[i]); bs = args[i];
if (SCHEME_CHAR_STRINGP(args[i]))
bs = scheme_char_string_to_byte_string_locale(bs);
argv[i - 3] = SCHEME_BYTE_STR_VAL(bs); argv[i - 3] = SCHEME_BYTE_STR_VAL(bs);
} }
} }
@ -7952,7 +7962,10 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
if (errport) { mzCLOSE_FILE_HANDLE(err_subprocess, 1); } if (errport) { mzCLOSE_FILE_HANDLE(err_subprocess, 1); }
scheme_raise_exn(MZEXN_FAIL, "%s: pipe failed (%e)", name, errno); scheme_raise_exn(MZEXN_FAIL, "%s: pipe failed (%e)", name, errno);
} }
if (!errport && PIPE_FUNC(err_subprocess, 0 _EXTRA_PIPE_ARGS)) { if (!errport && stderr_is_stdout) {
err_subprocess[0] = from_subprocess[0];
err_subprocess[1] = from_subprocess[1];
} else if (!errport && PIPE_FUNC(err_subprocess, 0 _EXTRA_PIPE_ARGS)) {
if (!inport) { if (!inport) {
MSC_IZE(close)(to_subprocess[0]); MSC_IZE(close)(to_subprocess[0]);
MSC_IZE(close)(to_subprocess[1]); MSC_IZE(close)(to_subprocess[1]);
@ -8113,8 +8126,10 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
mzCLOSE_FILE_HANDLE(from_subprocess, 1); mzCLOSE_FILE_HANDLE(from_subprocess, 1);
} }
if (!errport) { if (!errport) {
if (!stderr_is_stdout) {
MSC_IZE(close)(err_subprocess[0]); MSC_IZE(close)(err_subprocess[0]);
MSC_IZE(close)(err_subprocess[1]); MSC_IZE(close)(err_subprocess[1]);
}
} else { } else {
mzCLOSE_FILE_HANDLE(err_subprocess, 1); mzCLOSE_FILE_HANDLE(err_subprocess, 1);
} }
@ -8139,9 +8154,11 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
MSC_IZE(close)(from_subprocess[1]); MSC_IZE(close)(from_subprocess[1]);
} }
if (!errport) { if (!errport) {
if (!stderr_is_stdout) {
MSC_IZE(close)(err_subprocess[0]); MSC_IZE(close)(err_subprocess[0]);
MSC_IZE(close)(err_subprocess[1]); MSC_IZE(close)(err_subprocess[1]);
} }
}
#ifdef CLOSE_ALL_FDS_AFTER_FORK #ifdef CLOSE_ALL_FDS_AFTER_FORK
/* Actually, unwanted includes everything /* Actually, unwanted includes everything
@ -8232,6 +8249,7 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
in = scheme_false; in = scheme_false;
} }
if (!errport) { if (!errport) {
if (!stderr_is_stdout)
mzCLOSE_PIPE_END(err_subprocess[1]); mzCLOSE_PIPE_END(err_subprocess[1]);
err = NULL; err = NULL;
} else { } else {
@ -8245,6 +8263,9 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
in = (in ? in : make_fd_input_port(from_subprocess[0], scheme_intern_symbol("subprocess-stdout"), 0, 0, NULL, 0)); in = (in ? in : make_fd_input_port(from_subprocess[0], scheme_intern_symbol("subprocess-stdout"), 0, 0, NULL, 0));
out = (out ? out : make_fd_output_port(to_subprocess[1], scheme_intern_symbol("subprocess-stdin"), 0, 0, 0, -1)); out = (out ? out : make_fd_output_port(to_subprocess[1], scheme_intern_symbol("subprocess-stdin"), 0, 0, 0, -1));
if (stderr_is_stdout)
err = scheme_false;
else
err = (err ? err : make_fd_input_port(err_subprocess[0], scheme_intern_symbol("subprocess-stderr"), 0, 0, NULL, 0)); err = (err ? err : make_fd_input_port(err_subprocess[0], scheme_intern_symbol("subprocess-stderr"), 0, 0, NULL, 0));
/*--------------------------------------*/ /*--------------------------------------*/