build: Build and check (ice-9 popen) only when --enable-posix and HAVE_FORK.

Fixes <http://bugs.gnu.org/13848>.
Reported by Jan Schukat <shookie@email.de>.

* 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'.

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

doc/ref/api-options.texi

@@ -1,6 +1,7 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Guile Reference Manual.
-@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2008, 2009, 2010, 2011, 2012
+@c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+@c   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}).
 
+@item fork
+Indicates support for the POSIX @code{fork} function (@pxref{Processes,
+@code{primitive-fork}}).  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

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:
+module@footnote{This module is only available on systems where the
+@code{fork} feature is provided (@pxref{Common Feature Symbols}).}:
 
 @lisp
 (use-modules (ice-9 popen))

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,

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 \

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 (test-suite lib))
-  #:use-module (ice-9 popen))
-
 
 ;; 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
-;; open-input-pipe
+ (use-modules (ice-9 popen))
-;;
 
-(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
+ ;; open-input-pipe
-  ;; 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)))
 
-  )
+ (with-test-prefix "open-input-pipe"
 
-;;
+   (pass-if-exception "no args" exception:wrong-num-args
-;; open-output-pipe
+     (open-input-pipe))
-;;
 
-(with-test-prefix "open-output-pipe"
+   (pass-if "port?"
-  
+     (port? (open-input-pipe "echo hello")))
-  (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)))))
 
-  )
+   (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
-;; close-pipe
+   (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)
 
-(with-test-prefix "close-pipe"
+   ;; exercise file descriptor setups when stdout is the same as stderr
-  
+   (pass-if "stdout==stderr"
-  (pass-if-exception "no args" exception:wrong-num-args
+     (let ((port (open-file "/dev/null" "r+")))
-    (close-pipe))
+       (with-output-to-port port
-  
+         (lambda ()
-  (pass-if "exit 0"
+           (with-error-to-port port
-    (let ((st (close-pipe (open-output-pipe "exit 0"))))
+             (lambda ()
-      (and (status:exit-val st)
+               (open-input-pipe "echo hello"))))))
-	   (= 0 (status:exit-val st)))))
+     #t)
-  
-  (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 "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)))))))