[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-259-gbeac4
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-259-gbeac49b |
|
Date: |
Fri, 29 Mar 2013 18:20:20 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=beac49b8e129b28902f4b600e15aa3b92c9ce7fd
The branch, stable-2.0 has been updated
via beac49b8e129b28902f4b600e15aa3b92c9ce7fd (commit)
via df3d365a99311ecfe921d1dfd1848ff65112e572 (commit)
via 7e7c6f6a937005b08fffd5aeccdf992459b07137 (commit)
from 7bfbd2935fa812a0581df5b78c1a3b9836065f39 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit beac49b8e129b28902f4b600e15aa3b92c9ce7fd
Author: Ludovic Courtès <address@hidden>
Date: Fri Mar 29 19:19:51 2013 +0100
Augment `.gitignore'.
commit df3d365a99311ecfe921d1dfd1848ff65112e572
Author: Ludovic Courtès <address@hidden>
Date: Fri Mar 29 19:04:56 2013 +0100
build: Build and check (ice-9 popen) only when --enable-posix and HAVE_FORK.
Fixes <http://bugs.gnu.org/13848>.
Reported by Jan Schukat <address@hidden>.
* configure.ac: Rename `HAVE_FORK' conditional to `BUILD_ICE_9_POPEN'.
Set it when both $enable_posix and $ac_cv_func_fork are true.
* libguile/posix.c (scm_init_posix): Add the `fork' feature.
* doc/ref/api-options.texi (Common Feature Symbols): Add `fork'.
* doc/ref/posix.texi (Pipes): Add footnote mentioning the `fork'
feature.
* module/Makefile.am (SCRIPTS_SOURCES): Make `scripts/autofrisk.scm' and
`scripts/scan-api.scm' conditional on `BUILD_ICE_9_POPEN'.
* test-suite/tests/popen.test (if-supported): New macro.
Wrap body in `if-supported'.
commit 7e7c6f6a937005b08fffd5aeccdf992459b07137
Author: Ludovic Courtès <address@hidden>
Date: Fri Mar 29 18:44:18 2013 +0100
build: Remove redundant check for `struct timespec'.
* m4/gnulib-cache.m4: Add `time'.
* lib/Makefile.am: Update, still from v0.0-7865-ga828bb2.
* configure.ac: Remove check for `struct timespec', which was redundant
with Gnulib, and conflicted with pthread-win32's <pthread.h>:
<http://lists.gnu.org/archive/html/bug-gnulib/2013-03/msg00096.html>.
-----------------------------------------------------------------------
Summary of changes:
.gitignore | 4 +
configure.ac | 21 +---
doc/ref/api-options.texi | 8 +-
doc/ref/posix.texi | 3 +-
lib/Makefile.am | 2 +-
libguile/posix.c | 1 +
m4/gnulib-cache.m4 | 3 +-
module/Makefile.am | 11 +-
test-suite/tests/popen.test | 354 +++++++++++++++++++++---------------------
9 files changed, 203 insertions(+), 204 deletions(-)
diff --git a/.gitignore b/.gitignore
index 98ca125..e4a93ac 100644
--- a/.gitignore
+++ b/.gitignore
@@ -152,3 +152,7 @@ INSTALL
/lib/wctype.h
/build-aux/ar-lib
/build-aux/test-driver
+*.trs
+/test-suite/standalone/test-smob-mark
+/test-suite/standalone/test-scm-values
+/test-suite/standalone/test-scm-to-latin1-string
diff --git a/configure.ac b/configure.ac
index 41a5577..1ba6f3d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -761,7 +761,8 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10
ctermid \
strcoll strcoll_l newlocale utimensat sched_getaffinity \
sched_setaffinity sendfile])
-AM_CONDITIONAL([HAVE_FORK], [test "x$ac_cv_func_fork" = "xyes"])
+AM_CONDITIONAL([BUILD_ICE_9_POPEN],
+ [test "x$enable_posix" = "xyes" && test "x$ac_cv_func_fork" = "xyes"])
# Reasons for testing:
# netdb.h - not in mingw
@@ -1301,24 +1302,6 @@ if test $scm_cv_struct_linger = yes; then
getsockopt and setsockopt system calls.])
fi
-
-# On mingw, struct timespec is in <pthread.h>.
-#
-AC_MSG_CHECKING(for struct timespec)
-AC_CACHE_VAL(scm_cv_struct_timespec,
- AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
-#include <time.h>
-#if HAVE_PTHREAD_H
-#include <pthread.h>
-#endif]], [[struct timespec t; t.tv_nsec = 100]])],
- [scm_cv_struct_timespec="yes"],
- [scm_cv_struct_timespec="no"]))
-AC_MSG_RESULT($scm_cv_struct_timespec)
-if test $scm_cv_struct_timespec = yes; then
- AC_DEFINE([HAVE_STRUCT_TIMESPEC], 1,
- [Define this if your system defines struct timespec via either <time.h> or
<pthread.h>.])
-fi
-
#--------------------------------------------------------------------
#
# Flags for thread support
diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi
index a1575c5..8fa4f98 100644
--- a/doc/ref/api-options.texi
+++ b/doc/ref/api-options.texi
@@ -1,6 +1,7 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005,
2006, 2008, 2009, 2010, 2011, 2012
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005,
2006,
address@hidden 2008, 2009, 2010, 2011, 2012, 2013
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -281,6 +282,11 @@ Databases}).
Indicates support for POSIX functions: @code{pipe}, @code{getgroups},
@code{kill}, @code{execl} and so on (@pxref{POSIX}).
address@hidden fork
+Indicates support for the POSIX @code{fork} function (@pxref{Processes,
address@hidden). This is a prerequisite for the @code{(ice-9
+popen)} module (@pxref{Pipes}).
+
@item random
Indicates availability of random number generation functions:
@code{random}, @code{copy-random-state}, @code{random-uniform} and so on
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 341191a..870717e 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -2188,7 +2188,8 @@ controlling terminal. The return value is unspecified.
The following procedures are similar to the @code{popen} and
@code{pclose} system routines. The code is in a separate ``popen''
-module:
address@hidden module is only available on systems where the
address@hidden feature is provided (@pxref{Common Feature Symbols}).}:
@lisp
(use-modules (ice-9 popen))
diff --git a/lib/Makefile.am b/lib/Makefile.am
index c92a8ac..fdcd45d 100644
--- a/lib/Makefile.am
+++ b/lib/Makefile.am
@@ -21,7 +21,7 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --dir=. --local-dir=gnulib-local
--lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests
--aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool
--macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen
autobuild bind byteswap canonicalize-lgpl ceil clock-time close connect dirfd
duplocale environ extensions flock floor fpieee frexp fstat full-read
full-write func gendocs getaddrinfo getlogin getpeername getsockname getsockopt
git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib
iconv_open-utf inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions
lib-symbol-visibility libunistring listen localcharset locale log1p
maintainer-makefile malloc-gnu malloca nl_langinfo nproc open pipe-posix pipe2
poll putenv recv recvfrom regex rename select send sendto setenv setsockopt
shutdown socket stat-time stdlib strftime striconveh string sys_stat times
trunc verify vsnprintf warnings wchar
+# Reproduce by: gnulib-tool --import --dir=. --local-dir=gnulib-local
--lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests
--aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool
--macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen
autobuild bind byteswap canonicalize-lgpl ceil clock-time close connect dirfd
duplocale environ extensions flock floor fpieee frexp fstat full-read
full-write func gendocs getaddrinfo getlogin getpeername getsockname getsockopt
git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib
iconv_open-utf inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions
lib-symbol-visibility libunistring listen localcharset locale log1p
maintainer-makefile malloc-gnu malloca nl_langinfo nproc open pipe-posix pipe2
poll putenv recv recvfrom regex rename select send sendto setenv setsockopt
shutdown socket stat-time stdlib strftime striconveh string sys_stat time times
trunc verify vsnprintf warnings wchar
AUTOMAKE_OPTIONS = 1.5 gnits subdir-objects
diff --git a/libguile/posix.c b/libguile/posix.c
index 99f758f..8651818 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -2336,6 +2336,7 @@ scm_init_posix ()
#include "libguile/posix.x"
#ifdef HAVE_FORK
+ scm_add_feature ("fork");
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_popen",
(scm_t_extension_init_func) scm_init_popen,
diff --git a/m4/gnulib-cache.m4 b/m4/gnulib-cache.m4
index 02c8bcb..f367e35 100644
--- a/m4/gnulib-cache.m4
+++ b/m4/gnulib-cache.m4
@@ -27,7 +27,7 @@
# Specification in the form of a command-line invocation:
-# gnulib-tool --import --dir=. --local-dir=gnulib-local --lib=libgnu
--source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests
--aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool
--macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen
autobuild bind byteswap canonicalize-lgpl ceil clock-time close connect dirfd
duplocale environ extensions flock floor fpieee frexp fstat full-read
full-write func gendocs getaddrinfo getlogin getpeername getsockname getsockopt
git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib
iconv_open-utf inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions
lib-symbol-visibility libunistring listen localcharset locale log1p
maintainer-makefile malloc-gnu malloca nl_langinfo nproc open pipe-posix pipe2
poll putenv recv recvfrom regex rename select send sendto setenv setsockopt
shutdown socket stat-time stdlib strftime striconveh string sys_stat times
trunc verify vsnprintf warnings wchar
+# gnulib-tool --import --dir=. --local-dir=gnulib-local --lib=libgnu
--source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests
--aux-dir=build-aux --lgpl=3 --no-conditional-dependencies --libtool
--macro-prefix=gl --no-vc-files accept alignof alloca-opt announce-gen
autobuild bind byteswap canonicalize-lgpl ceil clock-time close connect dirfd
duplocale environ extensions flock floor fpieee frexp fstat full-read
full-write func gendocs getaddrinfo getlogin getpeername getsockname getsockopt
git-version-gen gitlog-to-changelog gnu-web-doc-update gnupload havelib
iconv_open-utf inet_ntop inet_pton isinf isnan ldexp lib-symbol-versions
lib-symbol-visibility libunistring listen localcharset locale log1p
maintainer-makefile malloc-gnu malloca nl_langinfo nproc open pipe-posix pipe2
poll putenv recv recvfrom regex rename select send sendto setenv setsockopt
shutdown socket stat-time stdlib strftime striconveh string sys_stat time times
trunc verify vsnprintf warnings wchar
# Specification in the form of a few gnulib-tool.m4 macro invocations:
gl_LOCAL_DIR([gnulib-local])
@@ -107,6 +107,7 @@ gl_MODULES([
striconveh
string
sys_stat
+ time
times
trunc
verify
diff --git a/module/Makefile.am b/module/Makefile.am
index 416ad22..d43be04 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -159,7 +159,6 @@ BRAINFUCK_LANG_SOURCES = \
language/brainfuck/spec.scm
SCRIPTS_SOURCES = \
- scripts/autofrisk.scm \
scripts/compile.scm \
scripts/disassemble.scm \
scripts/display-commentary.scm \
@@ -175,7 +174,6 @@ SCRIPTS_SOURCES = \
scripts/use2dot.scm \
scripts/snarf-check-and-output-texi.scm \
scripts/summarize-guile-TODO.scm \
- scripts/scan-api.scm \
scripts/api-diff.scm \
scripts/read-rfc822.scm \
scripts/snarf-guile-m4-docs.scm
@@ -252,12 +250,17 @@ ICE_9_SOURCES = \
ice-9/serialize.scm \
ice-9/local-eval.scm
-if HAVE_FORK
+if BUILD_ICE_9_POPEN
# This functionality is missing on systems without `fork'---i.e., Windows.
ICE_9_SOURCES += ice-9/popen.scm
-endif HAVE_FORK
+# These modules rely on (ice-9 popen).
+SCRIPTS_SOURCES += \
+ scripts/autofrisk.scm \
+ scripts/scan-api.scm
+
+endif BUILD_ICE_9_POPEN
SRFI_SOURCES = \
srfi/srfi-2.scm \
diff --git a/test-suite/tests/popen.test b/test-suite/tests/popen.test
index bfd7da7..2818be0 100644
--- a/test-suite/tests/popen.test
+++ b/test-suite/tests/popen.test
@@ -1,25 +1,23 @@
;;;; popen.test --- exercise ice-9/popen.scm -*- scheme -*-
;;;;
-;;;; Copyright 2003, 2006, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2006, 2010, 2011, 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
-;;;;
+;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; 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 (ice-9 popen))
-
+ #:use-module (test-suite lib))
;; read from PORT until eof is reached, return what's read as a string
(define (read-string-to-eof port)
@@ -37,176 +35,178 @@
thunk
restore-signals))
+(define-syntax-rule (if-supported body ...)
+ (if (provided? 'fork)
+ (begin body ...)))
+
+(if-supported
+ (use-modules (ice-9 popen))
+
+
+ ;;
+ ;; open-input-pipe
+ ;;
+
+ (with-test-prefix "open-input-pipe"
+
+ (pass-if-exception "no args" exception:wrong-num-args
+ (open-input-pipe))
+
+ (pass-if "port?"
+ (port? (open-input-pipe "echo hello")))
+
+ (pass-if "echo hello"
+ (string=? "hello\n" (read-string-to-eof (open-input-pipe "echo hello"))))
+
+ ;; exercise file descriptor setups when stdin is the same as stderr
+ (pass-if "stdin==stderr"
+ (let ((port (open-file "/dev/null" "r+")))
+ (with-input-from-port port
+ (lambda ()
+ (with-error-to-port port
+ (lambda ()
+ (open-input-pipe "echo hello"))))))
+ #t)
+
+ ;; exercise file descriptor setups when stdout is the same as stderr
+ (pass-if "stdout==stderr"
+ (let ((port (open-file "/dev/null" "r+")))
+ (with-output-to-port port
+ (lambda ()
+ (with-error-to-port port
+ (lambda ()
+ (open-input-pipe "echo hello"))))))
+ #t)
+
+ (pass-if "open-input-pipe process gets (current-input-port) as stdin"
+ (let* ((p2c (pipe))
+ (port (with-input-from-port (car p2c)
+ (lambda ()
+ (open-input-pipe "read line && echo $line")))))
+ (display "hello\n" (cdr p2c))
+ (force-output (cdr p2c))
+ (let ((result (eq? (read port) 'hello)))
+ (close-port (cdr p2c))
+ (close-pipe port)
+ result)))
+
+ ;; After the child closes stdout (which it indicates here by writing
+ ;; "closed" to stderr), the parent should see eof. In Guile 1.6.4
+ ;; and earlier a duplicate of stdout existed in the child, meaning
+ ;; eof was not seen.
+ ;;
+ ;; Note that the objective here is to test that the parent sees EOF
+ ;; while the child is still alive. (It is obvious that the parent
+ ;; must see EOF once the child has died.) The use of the `p2c'
+ ;; pipe, and `echo closed' and `read' in the child, allows us to be
+ ;; sure that we are testing what the parent sees at a point where
+ ;; the child has closed stdout but is still alive.
+ (pass-if "no duplicate"
+ (let* ((c2p (pipe))
+ (p2c (pipe))
+ (port (with-error-to-port (cdr c2p)
+ (lambda ()
+ (with-input-from-port (car p2c)
+ (lambda ()
+ (open-input-pipe
+ "exec 1>/dev/null; echo closed 1>&2; exec
2>/dev/null; read REPLY")))))))
+ (close-port (cdr c2p)) ;; write side
+ (let ((result (eof-object? (read-char port))))
+ (display "hello!\n" (cdr p2c))
+ (force-output (cdr p2c))
+ (close-pipe port)
+ result))))
+
+ ;;
+ ;; open-output-pipe
+ ;;
+
+ (with-test-prefix "open-output-pipe"
+
+ (pass-if-exception "no args" exception:wrong-num-args
+ (open-output-pipe))
+
+ (pass-if "port?"
+ (port? (open-output-pipe "exit 0")))
+
+ ;; exercise file descriptor setups when stdin is the same as stderr
+ (pass-if "stdin==stderr"
+ (let ((port (open-file "/dev/null" "r+")))
+ (with-input-from-port port
+ (lambda ()
+ (with-error-to-port port
+ (lambda ()
+ (open-output-pipe "exit 0"))))))
+ #t)
+
+ ;; exercise file descriptor setups when stdout is the same as stderr
+ (pass-if "stdout==stderr"
+ (let ((port (open-file "/dev/null" "r+")))
+ (with-output-to-port port
+ (lambda ()
+ (with-error-to-port port
+ (lambda ()
+ (open-output-pipe "exit 0"))))))
+ #t)
+
+ ;; After the child closes stdin (which it indicates here by writing
+ ;; "closed" to stderr), the parent should see a broken pipe. We
+ ;; setup to see this as EPIPE (rather than SIGPIPE). In Guile 1.6.4
+ ;; and earlier a duplicate of stdin existed in the child, preventing
+ ;; the broken pipe occurring.
+ ;;
+ ;; Note that the objective here is to test that the parent sees a
+ ;; broken pipe while the child is still alive. (It is obvious that
+ ;; the parent will see a broken pipe once the child has died.) The
+ ;; use of the `c2p' pipe, and the repeated `echo closed' in the
+ ;; child, allows us to be sure that we are testing what the parent
+ ;; sees at a point where the child has closed stdin but is still
+ ;; alive.
+ ;;
+ ;; Note that `with-epipe' must apply only to the parent and not to
+ ;; the child process; we rely on the child getting SIGPIPE, to
+ ;; terminate it (and avoid leaving a zombie).
+ (pass-if "no duplicate"
+ (let* ((c2p (pipe))
+ (port (with-error-to-port (cdr c2p)
+ (lambda ()
+ (open-output-pipe
+ (string-append "exec guile --no-auto-compile -s \""
+ (getenv "TEST_SUITE_DIR")
+ "/tests/popen-child.scm\""))))))
+ (close-port (cdr c2p)) ;; write side
+ (with-epipe
+ (lambda ()
+ (let ((result
+ (and (char? (read-char (car c2p))) ;; wait for child to do
its thing
+ (catch 'system-error
+ (lambda ()
+ (write-char #\x port)
+ (force-output port)
+ #f)
+ (lambda (key name fmt args errno-list)
+ (= (car errno-list) EPIPE))))))
+ ;; Now close our reading end of the pipe. This should give
+ ;; the child a broken pipe and so allow it to exit.
+ (close-port (car c2p))
+ (close-pipe port)
+ result))))))
+
+ ;;
+ ;; close-pipe
+ ;;
+
+ (with-test-prefix "close-pipe"
+
+ (pass-if-exception "no args" exception:wrong-num-args
+ (close-pipe))
-;;
-;; open-input-pipe
-;;
-
-(with-test-prefix "open-input-pipe"
-
- (pass-if-exception "no args" exception:wrong-num-args
- (open-input-pipe))
-
- (pass-if "port?"
- (port? (open-input-pipe "echo hello")))
-
- (pass-if "echo hello"
- (string=? "hello\n" (read-string-to-eof (open-input-pipe "echo hello"))))
-
- ;; exercise file descriptor setups when stdin is the same as stderr
- (pass-if "stdin==stderr"
- (let ((port (open-file "/dev/null" "r+")))
- (with-input-from-port port
- (lambda ()
- (with-error-to-port port
- (lambda ()
- (open-input-pipe "echo hello"))))))
- #t)
-
- ;; exercise file descriptor setups when stdout is the same as stderr
- (pass-if "stdout==stderr"
- (let ((port (open-file "/dev/null" "r+")))
- (with-output-to-port port
- (lambda ()
- (with-error-to-port port
- (lambda ()
- (open-input-pipe "echo hello"))))))
- #t)
-
- (pass-if "open-input-pipe process gets (current-input-port) as stdin"
- (let* ((p2c (pipe))
- (port (with-input-from-port (car p2c)
- (lambda ()
- (open-input-pipe "read line && echo $line")))))
- (display "hello\n" (cdr p2c))
- (force-output (cdr p2c))
- (let ((result (eq? (read port) 'hello)))
- (close-port (cdr p2c))
- (close-pipe port)
- result)))
-
- ;; After the child closes stdout (which it indicates here by writing
- ;; "closed" to stderr), the parent should see eof. In Guile 1.6.4
- ;; and earlier a duplicate of stdout existed in the child, meaning
- ;; eof was not seen.
- ;;
- ;; Note that the objective here is to test that the parent sees EOF
- ;; while the child is still alive. (It is obvious that the parent
- ;; must see EOF once the child has died.) The use of the `p2c'
- ;; pipe, and `echo closed' and `read' in the child, allows us to be
- ;; sure that we are testing what the parent sees at a point where
- ;; the child has closed stdout but is still alive.
- (pass-if "no duplicate"
- (let* ((c2p (pipe))
- (p2c (pipe))
- (port (with-error-to-port (cdr c2p)
- (lambda ()
- (with-input-from-port (car p2c)
- (lambda ()
- (open-input-pipe
- "exec 1>/dev/null; echo closed 1>&2; exec
2>/dev/null; read REPLY")))))))
- (close-port (cdr c2p)) ;; write side
- (let ((result (eof-object? (read-char port))))
- (display "hello!\n" (cdr p2c))
- (force-output (cdr p2c))
- (close-pipe port)
- result)))
-
- )
-
-;;
-;; open-output-pipe
-;;
-
-(with-test-prefix "open-output-pipe"
-
- (pass-if-exception "no args" exception:wrong-num-args
- (open-output-pipe))
-
- (pass-if "port?"
- (port? (open-output-pipe "exit 0")))
-
- ;; exercise file descriptor setups when stdin is the same as stderr
- (pass-if "stdin==stderr"
- (let ((port (open-file "/dev/null" "r+")))
- (with-input-from-port port
- (lambda ()
- (with-error-to-port port
- (lambda ()
- (open-output-pipe "exit 0"))))))
- #t)
-
- ;; exercise file descriptor setups when stdout is the same as stderr
- (pass-if "stdout==stderr"
- (let ((port (open-file "/dev/null" "r+")))
- (with-output-to-port port
- (lambda ()
- (with-error-to-port port
- (lambda ()
- (open-output-pipe "exit 0"))))))
- #t)
-
- ;; After the child closes stdin (which it indicates here by writing
- ;; "closed" to stderr), the parent should see a broken pipe. We
- ;; setup to see this as EPIPE (rather than SIGPIPE). In Guile 1.6.4
- ;; and earlier a duplicate of stdin existed in the child, preventing
- ;; the broken pipe occurring.
- ;;
- ;; Note that the objective here is to test that the parent sees a
- ;; broken pipe while the child is still alive. (It is obvious that
- ;; the parent will see a broken pipe once the child has died.) The
- ;; use of the `c2p' pipe, and the repeated `echo closed' in the
- ;; child, allows us to be sure that we are testing what the parent
- ;; sees at a point where the child has closed stdin but is still
- ;; alive.
- ;;
- ;; Note that `with-epipe' must apply only to the parent and not to
- ;; the child process; we rely on the child getting SIGPIPE, to
- ;; terminate it (and avoid leaving a zombie).
- (pass-if "no duplicate"
- (let* ((c2p (pipe))
- (port (with-error-to-port (cdr c2p)
- (lambda ()
- (open-output-pipe
- (string-append "exec guile --no-auto-compile -s \""
- (getenv "TEST_SUITE_DIR")
- "/tests/popen-child.scm\""))))))
- (close-port (cdr c2p)) ;; write side
- (with-epipe
- (lambda ()
- (let ((result
- (and (char? (read-char (car c2p))) ;; wait for child to do its
thing
- (catch 'system-error
- (lambda ()
- (write-char #\x port)
- (force-output port)
- #f)
- (lambda (key name fmt args errno-list)
- (= (car errno-list) EPIPE))))))
- ;; Now close our reading end of the pipe. This should give
- ;; the child a broken pipe and so allow it to exit.
- (close-port (car c2p))
- (close-pipe port)
- result)))))
-
- )
-
-;;
-;; close-pipe
-;;
-
-(with-test-prefix "close-pipe"
-
- (pass-if-exception "no args" exception:wrong-num-args
- (close-pipe))
-
- (pass-if "exit 0"
- (let ((st (close-pipe (open-output-pipe "exit 0"))))
- (and (status:exit-val st)
- (= 0 (status:exit-val st)))))
-
- (pass-if "exit 1"
- (let ((st (close-pipe (open-output-pipe "exit 1"))))
- (and (status:exit-val st)
- (= 1 (status:exit-val st))))))
+ (pass-if "exit 0"
+ (let ((st (close-pipe (open-output-pipe "exit 0"))))
+ (and (status:exit-val st)
+ (= 0 (status:exit-val st)))))
+ (pass-if "exit 1"
+ (let ((st (close-pipe (open-output-pipe "exit 1"))))
+ (and (status:exit-val st)
+ (= 1 (status:exit-val st)))))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-259-gbeac49b,
Ludovic Courtès <=