From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: Rutger van Beusekom Newsgroups: gmane.lisp.guile.devel Subject: Re: guile pipeline do-over Date: Sat, 04 Apr 2020 10:01:59 +0200 Message-ID: <87imifr85k.fsf@verum.com> References: <8736al24jt.fsf@verum.com> <87imjgi2vs.fsf@gnu.org> <877dzsy84v.fsf@verum.com> <87pnczeb32.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="45990"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: mu4e 1.2.0; emacs 26.3 Cc: Rutger van Beusekom , Andy Wingo , Guile Devel To: Ludovic =?utf-8?Q?Court=C3=A8s?= Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Sat Apr 04 10:02:58 2020 Return-path: Envelope-to: guile-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1jKdlX-000Bnn-S0 for guile-devel@m.gmane-mx.org; Sat, 04 Apr 2020 10:02:55 +0200 Original-Received: from localhost ([::1]:36406 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jKdlW-0000jt-L9 for guile-devel@m.gmane-mx.org; Sat, 04 Apr 2020 04:02:54 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:44861) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jKdkm-0000jk-8n for guile-devel@gnu.org; Sat, 04 Apr 2020 04:02:10 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jKdkj-0003bd-JV for guile-devel@gnu.org; Sat, 04 Apr 2020 04:02:07 -0400 Original-Received: from mail-vi1eur05on2115.outbound.protection.outlook.com ([40.107.21.115]:11644 helo=EUR05-VI1-obe.outbound.protection.outlook.com) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1jKdki-0003WU-Uu; Sat, 04 Apr 2020 04:02:05 -0400 ARC-Seal: i=1; a=rsa-sha256; s=arcselector9901; d=microsoft.com; cv=none; b=Q50fhmKr2Au+6nYXiftz07yuzOmsWZburQHhreDdlPe7m2BGwrL/LeUIQsg0PtKsL6fBvO9JZIKwCCE6i5Qwbq0KqGJpm2GzDWf8ZT9s+oM8boBQMhdTOPqHB8aiLJiE28MPTXXzfaqWeu4Mzry8Y/8et6p35FBZoGdnDEi9em2xvaqx/5A4GKlcOsBk55kGuMMWHsKNSTx0G3ubaGVcxoBbVACZSnRiMh3JGSg0HrWLtc76kwpZb0UqUqVwd7QCqwDn8hunZUeRWTfKHBxbBfWmLkb6NG/GIs8+0SzYva7OSrtM4MOPqyq1dMHOCCPAbBg9+t4L7RyaKtlIJrBy6g== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=microsoft.com; s=arcselector9901; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=gr5Z8pOkWKtprZVjhrUo7bj/zlN7C++9khYRajf2KgE=; b=nf+ChMDjrmWa7xEqS42QkX3cuTtI1e3eivSQj5rRYFFbhY08BkK8swVHojZo+8DwAofkYNDK3bxayld0g4O7Y4OJfkvMOFfBfEG4xEi5eh+YtO2QtMLvAWQREQXy3w5FvR4mJId8ogx7K16m/5EPoNWMcLwTpsxb5w0xxXsYTzb0C/Q8FyvrMTeotINV+xDpvixRItgVZPoMmEe02exMSOnV0BvCy4Ag45LZf/s+9NlLfAYJFRxO5cRUW/GdPFGMN10Q7DhYgjOFMA77DFPo1TDD9DJSCx0SWgzzR5KeB1HaaogbDGmce63FcAz7bbaOeovgH1nyB+TOQ8Uw7zx+ow== ARC-Authentication-Results: i=1; mx.microsoft.com 1; spf=pass smtp.mailfrom=verum.com; dmarc=pass action=none header.from=verum.com; dkim=pass header.d=verum.com; arc=none DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=verumst.onmicrosoft.com; s=selector2-verumst-onmicrosoft-com; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=gr5Z8pOkWKtprZVjhrUo7bj/zlN7C++9khYRajf2KgE=; b=h3/jvI6cYRl3Xfl11yJC10/pFOjO260oQ3q5VNwOJQATF5sF6Ewnsyng283vF8MaBAaxboKm9nMId8+QCM/bvkD0wu+khyYWz5x2NRxjHXc5wlkvxLt1ctt5vy4XCaXGyv7dgFoInsDha+hO9JVWu/aAf/pycGQlWOiH9Hc29Gg= Authentication-Results: spf=none (sender IP is ) smtp.mailfrom=rutger.van.beusekom@verum.com; Original-Received: from AM5PR0802MB2499.eurprd08.prod.outlook.com (10.175.45.135) by AM5PR0802MB2578.eurprd08.prod.outlook.com (10.175.44.22) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.2878.17; Sat, 4 Apr 2020 08:02:00 +0000 Original-Received: from AM5PR0802MB2499.eurprd08.prod.outlook.com ([fe80::d19f:7b5e:5545:2d29]) by AM5PR0802MB2499.eurprd08.prod.outlook.com ([fe80::d19f:7b5e:5545:2d29%9]) with mapi id 15.20.2878.016; Sat, 4 Apr 2020 08:02:00 +0000 In-reply-to: <87pnczeb32.fsf@gnu.org> X-ClientProxiedBy: AM3PR05CA0129.eurprd05.prod.outlook.com (2603:10a6:207:2::31) To AM5PR0802MB2499.eurprd08.prod.outlook.com (2603:10a6:203:a1::7) X-MS-Exchange-MessageSentRepresentingType: 1 Original-Received: from eigen (2001:1c03:4f0a:b200:a5d2:98de:c0b3:79b7) by AM3PR05CA0129.eurprd05.prod.outlook.com (2603:10a6:207:2::31) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.2878.15 via Frontend Transport; Sat, 4 Apr 2020 08:02:00 +0000 X-Originating-IP: [2001:1c03:4f0a:b200:a5d2:98de:c0b3:79b7] X-MS-PublicTrafficType: Email X-MS-Office365-Filtering-Correlation-Id: a78630c8-6dda-47f1-24e6-08d7d86e742b X-MS-TrafficTypeDiagnostic: AM5PR0802MB2578: X-MS-Exchange-Transport-Forked: True X-Microsoft-Antispam-PRVS: X-MS-Oob-TLC-OOBClassifiers: OLM:8273; X-Forefront-PRVS: 03630A6A4A X-Forefront-Antispam-Report: CIP:255.255.255.255; CTRY:; LANG:en; SCL:1; SRV:; IPV:NLI; SFV:NSPM; H:AM5PR0802MB2499.eurprd08.prod.outlook.com; PTR:; CAT:NONE; SFTY:; SFS:(10019020)(39830400003)(346002)(366004)(396003)(136003)(376002)(6486002)(86362001)(30864003)(3480700007)(2906002)(54906003)(6916009)(2616005)(8936002)(8676002)(66574012)(16526019)(4326008)(186003)(316002)(81166006)(81156014)(36756003)(33964004)(52116002)(66556008)(5660300002)(53546011)(508600001)(6496006)(66946007)(66616009)(66476007)(473944003); DIR:OUT; SFP:1102; Received-SPF: None (protection.outlook.com: verum.com does not designate permitted sender hosts) X-MS-Exchange-SenderADCheck: 1 X-Microsoft-Antispam: BCL:0; X-Microsoft-Antispam-Message-Info: sOz/qOd1YVJROpQdISqbhHtmpjxRamJlXjT1VRQly6scudug6lhSk6dMxbzaqj91Da5sXojwcCMYSnPZAT3qF7ds2pZGGBCvWttXxBR2uRzLVRekRodQCoJ5JDwd5m38+a04uVJ2TaYr8BDR6zlPsOvzvXyK61KcbbTgym6IFZbSkVwrfRl85nlgcJyrEzdPQ+PXwC1ZHd++XF7PgCpcIn3AaA/m4Ygt+PG8/zfOBupRwbWuRSwFV99AfCJH08H2gLBSl/Un8OUvKPM1jGE7TIPL7WrbaDAI5T/GS+Xjlao/ZoVifhMAql5F/qd9ws5Nv8TBxcsZFTVaKJq+jKivY9owADY6K5IlfLfG8kUVoxO1nibb2UuhvopAJdK/bBc3ty49quRCSHSziv/umQUicFjB2ROLObxOOPYyQUKZJNjIw9w6wdBD1jF8ju2LC4WGaZz+Q73/DDtACmbO57/mzny5AqP1IZ4YG/ZQ3ynKwOUCQ/sXutmEGRBkQdhq0JDm X-MS-Exchange-AntiSpam-MessageData: ffmYnB71y9XgMJczZw8n/GRtSMFRLSOux9QPOCm2UuEUPz4lpiGO3tMo1wKlNWJXho8Hqq8rzBrY4N3Dqm0h3tuRWywPe5ykL8rVOtZ5NqpNoKBIIOsPiZyWyZY+g196CGrBUjXv/F5pNrx1PlrmKFJGUwcWrrM73zrOTkfpy2ifRQMj9NZFqP9ij7v/3EL+Ak0ydkO9DYJvq4AwyK49rQ== X-OriginatorOrg: verum.com X-MS-Exchange-CrossTenant-Network-Message-Id: a78630c8-6dda-47f1-24e6-08d7d86e742b X-MS-Exchange-CrossTenant-OriginalArrivalTime: 04 Apr 2020 08:02:00.6259 (UTC) X-MS-Exchange-CrossTenant-FromEntityHeader: Hosted X-MS-Exchange-CrossTenant-Id: a12adc2b-ece0-4282-b9ce-ad23864dd7c5 X-MS-Exchange-CrossTenant-MailboxType: HOSTED X-MS-Exchange-CrossTenant-UserPrincipalName: UFw1sAyT9cRBNMomUBxEHbzS1C7nttiSkEEqTOLXQJmwwkDzY8JOwEB9LPyTmasEKNUUudCPXMHywfdkmechuw4rph3zPNde22CvupohBGg= X-MS-Exchange-Transport-CrossTenantHeadersStamped: AM5PR0802MB2578 X-detected-operating-system: by eggs.gnu.org: Windows NT kernel [generic] [fuzzy] X-Received-From: 40.107.21.115 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Original-Sender: "guile-devel" Xref: news.gmane.io gmane.lisp.guile.devel:20482 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi Ludo, Ludovic Court=C3=A8s writes: > Hi Rutger, > > (+Cc: Andy.) > > Rutger van Beusekom skribis: > >> From d351c0a5ecde62e63368bec0e1f15108495a1a71 Mon Sep 17 00:00:00 2001 >> From: Rutger van Beusekom >> Date: Mon, 2 Mar 2020 10:38:57 +0100 >> Subject: [PATCH] Add pipeline procedure. >> >> * libguile/posix.c (scm_open_process): Remove. >> (scm_piped_process): Add to replace open_process. >> * module/ice-9/popen.scm (pipe->fdes): Add to convert pipe pair to fdes = pair. >> (open-process): Add open-process for backwards compatibility. >> (pipeline): Add to implement a pipeline using piped-process. > > There are a couple super minor issues that I comment on below, but > otherwise LGTM! If Andy agrees, we can apply it once the copyright > assignment is on file, so maybe it won=E2=80=99t be in 3.0.2, we=E2=80=99= ll see! As yet I have not received a copyright assignment form. > >> +@deffn (Scheme Procedure) pipeline commands > ^ ^ > Should be braces. > >> +Execute a @code{pipeline} of @var{commands} -- where each command is a >> +list of a program and its arguments as strings -- returning an input > > s/--/---/ so we get an em dash and not an en dash (I=E2=80=99m a typograp= hy > nitpicker :-)). > >> +port to the end of the pipeline, an output port to the beginning of the >> +pipeline and a list of PIDs of the processes executing the @var{command= s}. >> + >> +@example >> +(let ((commands '(("git" "ls-files") >> + ("tar" "-cf-" "-T-") >> + ("sha1sum" "-"))) > ^ > There=E2=80=99s an extra space on these lines > >> + (pipe-fail? (compose not >> + zero? >> + status:exit-val >> + cdr >> + waitpid))) > > I don=E2=80=99t think we should encourage this style, which could also lo= ok > obscure to newcomers. I=E2=80=99d just make it a regular lambda. > Personally I really like composing procedures like a pipeline ;-), but I do not want to obscure things. > That=E2=80=99s all for me. > > Thanks again, Rutger! > > Ludo=E2=80=99. Thank you for helping me find where to dot the i's and cross the t's, please see the updated patch. Rutger. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Add-pipeline-procedure.patch Content-Description: PATCH >From 9fa48fa3917eb1fab61b703de936471c3c24f4f4 Mon Sep 17 00:00:00 2001 From: Rutger van Beusekom Date: Mon, 2 Mar 2020 10:38:57 +0100 Subject: [PATCH] Add pipeline procedure. * libguile/posix.c (scm_open_process): Remove. (scm_piped_process): Add to replace open_process. * module/ice-9/popen.scm (pipe->fdes): Add to convert pipe pair to fdes pair. (open-process): Add open-process for backwards compatibility. (pipeline): Add to implement a pipeline using piped-process. --- doc/ref/posix.texi | 28 ++++++++++++++++ libguile/posix.c | 66 ++++++++++--------------------------- module/ice-9/popen.scm | 46 +++++++++++++++++++++++++- test-suite/tests/popen.test | 37 ++++++++++++++++++++- 4 files changed, 127 insertions(+), 50 deletions(-) diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 2c85f803a..e5d63c7b3 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -2370,6 +2370,34 @@ processes, and a system-wide limit on the number of pipes, so pipes should be closed explicitly when no longer needed, rather than letting the garbage collector pick them up at some later time. +@findex pipeline +@deffn {Scheme Procedure} pipeline commands +Execute a @code{pipeline} of @var{commands} --- where each command is a +list of a program and its arguments as strings --- returning an input +port to the end of the pipeline, an output port to the beginning of the +pipeline and a list of PIDs of the processes executing the @var{commands}. + +@example +(let ((commands '(("git" "ls-files") + ("tar" "-cf-" "-T-") + ("sha1sum" "-"))) + (pipe-fail? (lambda (pid) + (not + (zero? + (status:exit-val + (cdr + (waitpid pid)))))))) + (receive (from to pids) (pipeline commands) + (let* ((sha1 (read-delimited " " from)) + (index (list-index pipe-fail? (reverse pids)))) + (close to) + (close from) + (if (not index) sha1 + (string-append "pipeline failed in command: " + (string-join (list-ref commands index))))))) +@result{} "52f99d234503fca8c84ef94b1005a3a28d8b3bc1" +@end example +@end deffn @node Networking @subsection Networking diff --git a/libguile/posix.c b/libguile/posix.c index 9b9b47636..b47b01701 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1372,10 +1372,9 @@ start_child (const char *exec_file, char **exec_argv, #ifdef HAVE_START_CHILD static SCM -scm_open_process (SCM mode, SCM prog, SCM args) -#define FUNC_NAME "open-process" +scm_piped_process (SCM prog, SCM args, SCM from, SCM to) +#define FUNC_NAME "piped-process" { - long mode_bits; int reading, writing; int c2p[2]; /* Child to parent. */ int p2c[2]; /* Parent to child. */ @@ -1383,44 +1382,27 @@ scm_open_process (SCM mode, SCM prog, SCM args) int pid; char *exec_file; char **exec_argv; - SCM read_port = SCM_BOOL_F, write_port = SCM_BOOL_F; exec_file = scm_to_locale_string (prog); exec_argv = scm_i_allocate_string_pointers (scm_cons (prog, args)); - mode_bits = scm_i_mode_bits (mode); - reading = mode_bits & SCM_RDNG; - writing = mode_bits & SCM_WRTNG; + reading = scm_is_pair (from); + writing = scm_is_pair (to); if (reading) { - if (pipe (c2p)) - { - int errno_save = errno; - free (exec_file); - errno = errno_save; - SCM_SYSERROR; - } + c2p[0] = scm_to_int (scm_car (from)); + c2p[1] = scm_to_int (scm_cdr (from)); out = c2p[1]; } - + if (writing) { - if (pipe (p2c)) - { - int errno_save = errno; - free (exec_file); - if (reading) - { - close (c2p[0]); - close (c2p[1]); - } - errno = errno_save; - SCM_SYSERROR; - } + p2c[0] = scm_to_int (scm_car (to)); + p2c[1] = scm_to_int (scm_cdr (to)); in = p2c[0]; } - + { SCM port; @@ -1453,23 +1435,12 @@ scm_open_process (SCM mode, SCM prog, SCM args) SCM_SYSERROR; } - /* There is no sense in catching errors on close(). */ if (reading) - { - close (c2p[1]); - read_port = scm_i_fdes_to_port (c2p[0], scm_mode_bits ("r0"), - sym_read_pipe, - SCM_FPORT_OPTION_NOT_SEEKABLE); - } + close (c2p[1]); if (writing) - { - close (p2c[0]); - write_port = scm_i_fdes_to_port (p2c[1], scm_mode_bits ("w0"), - sym_write_pipe, - SCM_FPORT_OPTION_NOT_SEEKABLE); - } + close (p2c[0]); - return scm_values_3 (read_port, write_port, scm_from_int (pid)); + return scm_from_int (pid); } #undef FUNC_NAME @@ -1514,8 +1485,8 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, "Example: (system* \"echo\" \"foo\" \"bar\")") #define FUNC_NAME s_scm_system_star { - SCM prog, res; - int pid, status, wait_result; + SCM prog, pid; + int status, wait_result; if (scm_is_null (args)) SCM_WRONG_NUM_ARGS (); @@ -1533,9 +1504,8 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, SCM_UNDEFINED); #endif - res = scm_open_process (scm_nullstr, prog, args); - pid = scm_to_int (scm_c_value_ref (res, 2)); - SCM_SYSCALL (wait_result = waitpid (pid, &status, 0)); + pid = scm_piped_process (prog, args, SCM_UNDEFINED, SCM_UNDEFINED); + SCM_SYSCALL (wait_result = waitpid (scm_to_int (pid), &status, 0)); if (wait_result == -1) SCM_SYSERROR; @@ -2382,7 +2352,7 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0, static void scm_init_popen (void) { - scm_c_define_gsubr ("open-process", 2, 0, 1, scm_open_process); + scm_c_define_gsubr ("piped-process", 2, 2, 0, scm_piped_process); } #endif /* HAVE_START_CHILD */ diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm index 2afe45701..5ab93f275 100644 --- a/module/ice-9/popen.scm +++ b/module/ice-9/popen.scm @@ -22,9 +22,10 @@ #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) #:use-module (ice-9 threads) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe - open-output-pipe open-input-output-pipe)) + open-output-pipe open-input-output-pipe pipeline)) (eval-when (expand load eval) (load-extension (string-append "libguile-" (effective-version)) @@ -84,6 +85,28 @@ (define port/pid-table (make-weak-key-hash-table)) (define port/pid-table-mutex (make-mutex)) +(define (pipe->fdes) + (let ((p (pipe))) + (cons (port->fdes (car p)) + (port->fdes (cdr p))))) + +(define (open-process mode command . args) + "Backwards compatible implementation of the former procedure in +libguile/posix.c (scm_open_process) replaced by +scm_piped_process. Executes the program @var{command} with optional +arguments @var{args} (all strings) in a subprocess. A port to the +process (based on pipes) is created and returned. @var{mode} specifies +whether an input, an output or an input-output port to the process is +created: it should be the value of @code{OPEN_READ}, @code{OPEN_WRITE} +or @code{OPEN_BOTH}." + (let* ((from (and (or (string=? mode OPEN_READ) + (string=? mode OPEN_BOTH)) (pipe->fdes))) + (to (and (or (string=? mode OPEN_WRITE) + (string=? mode OPEN_BOTH)) (pipe->fdes))) + (pid (piped-process command args from to))) + (values (and from (fdes->inport (car from))) + (and to (fdes->outport (cdr to))) pid))) + (define (open-pipe* mode command . args) "Executes the program @var{command} with optional arguments @var{args} (all strings) in a subprocess. @@ -176,3 +199,24 @@ information on how to interpret this value." "Equivalent to @code{open-pipe} with mode @code{OPEN_BOTH}" (open-pipe command OPEN_BOTH)) +(define (pipeline commands) + "Execute a pipeline of @var(commands) -- where each command is a list of a +program and its arguments as strings -- returning an input port to the +end of the pipeline, an output port to the beginning of the pipeline and +a list of PIDs of the processes executing the @var(commands)." + (let* ((to (pipe->fdes)) + (pipes (map (lambda _ (pipe->fdes)) commands)) + (pipeline (fold (lambda (from proc prev) + (let* ((to (car prev)) + (pids (cdr prev)) + (pid (piped-process (car proc) + (cdr proc) + from + to))) + (cons from (cons pid pids)))) + `(,to) + pipes + commands)) + (from (car pipeline)) + (pids (cdr pipeline))) + (values (fdes->inport (car from)) (fdes->outport (cdr to)) pids))) diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test index 2c0877484..c780de9a7 100644 --- a/test-suite/tests/popen.test +++ b/test-suite/tests/popen.test @@ -17,7 +17,10 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-suite test-ice-9-popen) - #:use-module (test-suite lib)) + #:use-module (test-suite lib) + #:use-module (ice-9 receive) + #:use-module (ice-9 rdelim)) + ;; read from PORT until eof is reached, return what's read as a string (define (read-string-to-eof port) @@ -211,3 +214,35 @@ exec 2>~a; read REPLY" (let ((st (close-pipe (open-output-pipe "exit 1")))) (and (status:exit-val st) (= 1 (status:exit-val st))))))) + + +;; +;; pipeline related tests +;; + +(pass-if "open-process" + (receive (from to pid) + ((@@ (ice-9 popen) open-process) OPEN_BOTH "rev") + (display "dlrow olleh" to) (close to) + (and (equal? "hello world" (read-string from)) + (= 0 (status:exit-val (cdr (waitpid pid))))))) + +(pass-if "piped-process" + (= 42 (status:exit-val + (cdr (waitpid ((@@ (ice-9 popen) piped-process) + "./meta/guile" '("-c" "(exit 42)"))))))) + +(pass-if "piped-process: with output" + (let* ((p (pipe)) + (pid ((@@ (ice-9 popen) piped-process) "echo" '("foo" "bar") + (cons (port->fdes (car p)) + (port->fdes (cdr p)))))) + + (and (equal? "foo bar\n" (read-string (car p))) + (= 0 (status:exit-val (cdr (waitpid pid))))))) + +(pass-if "pipeline" + (receive (from to pids) + (pipeline '(("echo" "dlrow olleh") ("rev"))) + (and (string=? "hello world\n" (read-string from)) + (equal? '(0 0) (map (compose status:exit-val cdr waitpid) pids))))) -- 2.25.1 --=-=-=--