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

'pipe' now takes an optional 'flags' parameter.

Browse source 
This is the same strategy as used for the 'accept4' bindings introduced
in 6e0965104c.

* libguile/posix.c (scm_pipe): Rename to...
(scm_pipe2): ... this.  Add an optional 'flags' parameter and honor it.
(scm_pipe): Rewrite as a call to 'scm_pipe2'.
* libguile/posix.h (scm_pipe2): New declaration.
* test-suite/tests/posix.test ("pipe"): New tests.
* configure.ac: Look for 'pipe2'.
* NEWS: Update.
This commit is contained in:
Ludovic Courtès 2022-09-19 22:27:10 +02:00
parent 9592516bfa
commit 1d313bf5f0
6 changed files with 110 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

51
libguile/posix.c
View file

@ -226,8 +226,8 @@ char *getlogin (void);
SCM_SYMBOL (sym_read_pipe, "read pipe");
SCM_SYMBOL (sym_write_pipe, "write pipe");
SCM_DEFINE (scm_pipe, "pipe", 0, 0, 0,
(),
SCM_DEFINE (scm_pipe2, "pipe", 0, 1, 0,
(SCM flags),
"Return a newly created pipe: a pair of ports which are linked\n"
"together on the local machine. The @emph{car} is the input\n"
"port and the @emph{cdr} is the output port. Data written (and\n"
@ -236,20 +236,54 @@ SCM_DEFINE (scm_pipe, "pipe", 0, 0, 0,
"child process. The need to flush the output port can be\n"
"avoided by making it unbuffered using @code{setvbuf}.\n"
"\n"
"Optionally, on systems that support it such as GNU/Linux and\n"
"GNU/Hurd, @var{flags} can specify a bitwise-or of the following\n"
"constants:\n"
"\n"
"@table @code\n"
"@item O_CLOEXEC\n"
"Mark the returned file descriptors as close-on-exec;\n"
"@item O_DIRECT\n"
"Create a pipe that performs input/output in \"packet\"\n"
"mode---see @command{man 2 pipe} for details;\n"
"@item O_NONBLOCK\n"
"Set the @code{O_NONBLOCK} status flag (non-blocking input and\n"
"output) on the file descriptors.\n"
"@end table\n"
"\n"
"On systems that do @emph{not} support it, passing a non-zero\n"
"@var{flags} value triggers a @code{system-error} exception.\n"
"\n"
"Writes occur atomically provided the size of the data in bytes\n"
"is not greater than the value of @code{PIPE_BUF}. Note that\n"
"the output port is likely to block if too much data (typically\n"
"equal to @code{PIPE_BUF}) has been written but not yet read\n"
"from the input port.")
#define FUNC_NAME s_scm_pipe
#define FUNC_NAME s_scm_pipe2
{
int fd[2], rv;
int fd[2], rv, c_flags;
SCM p_rd, p_wt;
rv = pipe (fd);
if (SCM_UNBNDP (flags))
c_flags = 0;
else
SCM_VALIDATE_INT_COPY (1, flags, c_flags);
#ifdef HAVE_PIPE2
rv = pipe2 (fd, c_flags);
#else
if (c_flags == 0)
rv = pipe (fd);
else
/* 'pipe2' cannot be emulated on systems that lack it: calling
'fnctl' afterwards to set the relevant flags is not equivalent
because it's not atomic. */
rv = ENOSYS;
#endif
if (rv)
SCM_SYSERROR;
p_rd = scm_i_fdes_to_port (fd[0], scm_mode_bits ("r"), sym_read_pipe,
SCM_FPORT_OPTION_NOT_SEEKABLE);
p_wt = scm_i_fdes_to_port (fd[1], scm_mode_bits ("w"), sym_write_pipe,
@ -258,6 +292,11 @@ SCM_DEFINE (scm_pipe, "pipe", 0, 0, 0,
}
#undef FUNC_NAME
SCM
scm_pipe (void)
{
return scm_pipe2 (SCM_INUM0);
}
#ifdef HAVE_GETGROUPS
SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,

3
libguile/posix.h
View file

@ -1,7 +1,7 @@
#ifndef SCM_POSIX_H
#define SCM_POSIX_H
/* Copyright 1995-1998,2000-2001,2003,2006,2008-2011,2018,2021
/* Copyright 1995-1998,2000-2001,2003,2006,2008-2011,2018,2021,2022
Free Software Foundation, Inc.
This file is part of Guile.
@ -34,6 +34,7 @@ SCM_API SCM scm_setsid (void);
SCM_API SCM scm_getsid (SCM pid);
SCM_API SCM scm_setpgid (SCM pid, SCM pgid);
SCM_API SCM scm_pipe (void);
SCM_INTERNAL SCM scm_pipe2 (SCM flags);
SCM_API SCM scm_getgroups (void);
SCM_API SCM scm_setgroups (SCM groups);
SCM_API SCM scm_getpgrp (void);