mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

slight open-pipe* / open-process refactor

Browse source 
* libguile/posix.c (scm_open_process): Return the ports as values
  instead of calling out to Scheme again to make-rw-port.  This
  function is private to (ice-9 popen).

* module/ice-9/popen.scm (open-pipe*): Adapt to change.
This commit is contained in:
Andy Wingo 2013-01-08 12:58:05 +01:00
parent ed3e8b8e06
commit 03a2f59851
2 changed files with 16 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

25
libguile/posix.c
View file

@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
* 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. * 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -1351,7 +1351,7 @@ scm_open_process (SCM mode, SCM prog, SCM args)
if (pid) if (pid)
/* Parent. */ /* Parent. */
{ {
SCM read_port = SCM_BOOL_F, write_port = SCM_BOOL_F, port; SCM read_port = SCM_BOOL_F, write_port = SCM_BOOL_F;
/* There is no sense in catching errors on close(). */ /* There is no sense in catching errors on close(). */
if (reading) if (reading)
@ -1367,25 +1367,8 @@ scm_open_process (SCM mode, SCM prog, SCM args)
scm_setvbuf (write_port, scm_from_int (_IONBF), SCM_UNDEFINED); scm_setvbuf (write_port, scm_from_int (_IONBF), SCM_UNDEFINED);
} }
if (reading && writing) return scm_values
{ (scm_list_3 (read_port, write_port, scm_from_int (pid)));
static SCM make_rw_port = SCM_BOOL_F;
if (scm_is_false (make_rw_port))
make_rw_port = scm_c_private_variable ("ice-9 popen",
"make-rw-port");
port = scm_call_2 (scm_variable_ref (make_rw_port),
read_port, write_port);
}
else if (reading)
port = read_port;
else if (writing)
port = write_port;
else
port = scm_sys_make_void_port (mode);
return scm_cons (port, scm_from_int (pid));
} }
/* The child. */ /* The child. */

16
module/ice-9/popen.scm
View file

@ -1,6 +1,6 @@
;; popen emulation, for non-stdio based ports. ;; popen emulation, for non-stdio based ports.
;;;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2006, 2010, 2011, 2012 Free Software Foundation, Inc. ;;;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2006, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -49,11 +49,17 @@ A port to the process (based on pipes) is created and returned.
@var{mode} specifies whether an input, an output or an input-output @var{mode} specifies whether an input, an output or an input-output
port to the process is created: it should be the value of port to the process is created: it should be the value of
@code{OPEN_READ}, @code{OPEN_WRITE} or @code{OPEN_BOTH}." @code{OPEN_READ}, @code{OPEN_WRITE} or @code{OPEN_BOTH}."
(let* ((port/pid (apply open-process mode command args)) (call-with-values (lambda ()
(port (car port/pid))) (apply open-process mode command args))
(lambda (read-port write-port pid)
(let ((port (or (and read-port write-port
(make-rw-port read-port write-port))
read-port
write-port
(%make-void-port mode))))
(pipe-guardian port) (pipe-guardian port)
(hashq-set! port/pid-table port (cdr port/pid)) (hashq-set! port/pid-table port pid)
port)) port))))
(define (open-pipe command mode) (define (open-pipe command mode)
"Executes the shell command @var{command} (a string) in a subprocess. "Executes the shell command @var{command} (a string) in a subprocess.