[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/ice-9 ChangeLog popen.scm
From: |
Gary Houston |
Subject: |
guile/guile-core/ice-9 ChangeLog popen.scm |
Date: |
Tue, 07 Nov 2000 13:36:43 -0800 |
CVSROOT: /cvs
Module name: guile
Changes by: Gary Houston <address@hidden> 00/11/07 13:36:42
Modified files:
guile-core/ice-9: ChangeLog popen.scm
Log message:
2000-11-06 Gary Houston <address@hidden>
* popen.scm (open-process): bug fix: don't use
close-all-ports-except to close ports in the child process, since
it causes port buffers to be flushed. they may be flushed again
in the parent, causing duplicate output. use a more elaborate
method for setting up the child descriptors (thanks to David
Pirotte for the bug report).
standard file descriptors 0, 1, 2 in the child process
are now set up from current-input-port etc., where possible.
CVSWeb URLs:
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/ice-9/ChangeLog.diff?r1=1.355&r2=1.356
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/ice-9/popen.scm.diff?r1=1.5&r2=1.6
Patches:
Index: guile/guile-core/ice-9/ChangeLog
diff -u guile/guile-core/ice-9/ChangeLog:1.355
guile/guile-core/ice-9/ChangeLog:1.356
--- guile/guile-core/ice-9/ChangeLog:1.355 Wed Nov 1 01:37:30 2000
+++ guile/guile-core/ice-9/ChangeLog Tue Nov 7 13:36:42 2000
@@ -1,3 +1,14 @@
+2000-11-06 Gary Houston <address@hidden>
+
+ * popen.scm (open-process): bug fix: don't use
+ close-all-ports-except to close ports in the child process, since
+ it causes port buffers to be flushed. they may be flushed again
+ in the parent, causing duplicate output. use a more elaborate
+ method for setting up the child descriptors (thanks to David
+ Pirotte for the bug report).
+ standard file descriptors 0, 1, 2 in the child process
+ are now set up from current-input-port etc., where possible.
+
2000-10-10 Dirk Herrmann <address@hidden>
* syncase.scm (eval): string=? requires a string argument.
Index: guile/guile-core/ice-9/popen.scm
diff -u guile/guile-core/ice-9/popen.scm:1.5
guile/guile-core/ice-9/popen.scm:1.6
--- guile/guile-core/ice-9/popen.scm:1.5 Tue Jun 27 06:52:49 2000
+++ guile/guile-core/ice-9/popen.scm Tue Nov 7 13:36:42 2000
@@ -12,6 +12,10 @@
;; a weak hash-table to store the process ids.
(define-public port/pid-table (make-weak-key-hash-table 31))
+(define (ensure-fdes port mode)
+ (or (false-if-exception (fileno port))
+ (open-fdes *null-device* mode)))
+
;; run a process connected to an input or output port.
;; mode: OPEN_READ or OPEN_WRITE.
;; returns port/pid pair.
@@ -23,10 +27,61 @@
(cond ((= pid 0)
;; child
(set-batch-mode?! #t)
- (close-all-ports-except (if reading (cdr p) (car p)))
- (move->fdes (if reading (cdr p) (car p))
- (if reading 1 0))
- (apply execlp prog prog args))
+
+ ;; select the three file descriptors to be used as
+ ;; standard descriptors 0, 1, 2 for the new process. one
+ ;; is the pipe to the parent, the other two are taken
+ ;; from the current Scheme input/output/error ports if
+ ;; possible.
+
+ (let ((input-fdes (if reading
+ (ensure-fdes (current-input-port)
+ O_RDONLY)
+ (fileno (car p))))
+ (output-fdes (if reading
+ (fileno (cdr p))
+ (ensure-fdes (current-output-port)
+ O_WRONLY)))
+ (error-fdes (ensure-fdes (current-error-port)
+ O_WRONLY)))
+
+ ;; close all file descriptors in ports inherited from
+ ;; the parent except for the three selected above.
+ ;; this is to avoid causing problems for other pipes in
+ ;; the parent.
+
+ ;; use low-level system calls, not close-port or the
+ ;; scsh routines, to avoid side-effects such as
+ ;; flushing port buffers or evicting ports.
+
+ (port-for-each (lambda (pt-entry)
+ (false-if-exception
+ (let ((pt-fileno (fileno pt-entry)))
+ (if (not (or (= pt-fileno input-fdes)
+ (= pt-fileno output-fdes)
+ (= pt-fileno error-fdes)))
+ (close-fdes pt-fileno))))))
+
+ ;; copy the three selected descriptors to the standard
+ ;; descriptors 0, 1, 2. note that it's possible that
+ ;; output-fdes or input-fdes is equal to error-fdes.
+
+ (cond ((not (= input-fdes 0))
+ (if (= output-fdes 0)
+ (set! output-fdes (dup->fdes 0)))
+ (if (= error-fdes 0)
+ (set! error-fdes (dup->fdes 0)))
+ (dup2 input-fdes 0)))
+
+ (cond ((not (= output-fdes 1))
+ (if (= error-fdes 1)
+ (set! error-fdes (dup->fdes 1)))
+ (dup2 output-fdes 1)))
+
+ (dup2 error-fdes 2)
+
+ (apply execlp prog prog args)))
+
(else
;; parent
(if reading
- guile/guile-core/ice-9 ChangeLog popen.scm,
Gary Houston <=