flush all open output buffers before fork(), exec(), system, qx//

and pipe open() operations, simplifying buffering headaches faced
by users; uses fflush(NULL), which may need Configure test

p4raw-id: //depot/perl@3352

9 files changed, 33 insertions, 21 deletions

diff --git a/perl.h b/perl.h
index 8f5082c011..febcdf43c8 100644
--- a/perl.h
+++ b/perl.h
@@ -1449,6 +1449,14 @@ typedef pthread_key_t	perl_key;
 #   define STATUS_ALL_FAILURE	(PL_statusvalue = 1)
 #endif
 
+/* This defines a way to flush all output buffers.  This may be a
+ * performance issue, so we allow people to disable it.
+ * XXX the default needs a Configure test, as it may not work everywhere.
+ */
+#ifndef PERL_FLUSHALL_FOR_CHILD
+#define PERL_FLUSHALL_FOR_CHILD	PerlIO_flush((PerlIO*)NULL)
+#endif
+
 /* Some unistd.h's give a prototype for pause() even though
    HAS_PAUSE ends up undefined.  This causes the #define
    below to be rejected by the compmiler.  Sigh.
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index edef071da4..9fb0819cf8 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -217,6 +217,14 @@ Parsing of here documents used to be flawed when they appeared as
 the replacement expression in C<eval 's/.../.../e'>.  This has
 been fixed.
 
+=head2 Automatic flushing of output buffers
+
+fork(), exec(), system(), qx// and pipe open()s now flush the buffers
+of all files that were opened for output at the time the operation
+was attempted.  The mostly eliminates the often confusing effects of
+buffering mishaps suffered by users unaware of how Perl internally
+handled I/O.
+
 =head1 Supported Platforms
 
 =over 4
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index a65e3e3e46..4d25fef4b5 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -1311,12 +1311,9 @@ the argument is checked for shell metacharacters, and if there are any,
 the entire argument is passed to the system's command shell for parsing
 (this is C</bin/sh -c> on Unix platforms, but varies on other platforms).
 If there are no shell metacharacters in the argument, it is split into
-words and passed directly to C<execvp()>, which is more efficient.  Note:
-C<exec()> and C<system()> do not flush your output buffer, so you may need to
-set C<$|> to avoid lost output.  Examples:
+words and passed directly to C<execvp()>, which is more efficient.
 
-    exec '/bin/echo', 'Your arguments are: ', @ARGV;
-    exec "sort $outfile | uniq";
+All files opened for output are flushed before attempting the exec().
 
 If you don't really want to execute the first argument, but want to lie
 to the program you are executing about its own name, you can specify
@@ -1542,9 +1539,7 @@ fork(), great care has gone into making it extremely efficient (for
 example, using copy-on-write technology on data pages), making it the
 dominant paradigm for multitasking over the last few decades.
 
-Note: unflushed buffers remain unflushed in both processes, which means
-you may need to set C<$|> ($AUTOFLUSH in English) or call the C<autoflush()>
-method of C<IO::Handle> to avoid duplicate output.
+All files opened for output are flushed before forking the child process.
 
 If you C<fork()> without ever waiting on your children, you will
 accumulate zombies.  On some systems, you can avoid this by setting
@@ -2527,11 +2522,10 @@ The following pairs are more or less equivalent:
 
 See L<perlipc/"Safe Pipe Opens"> for more examples of this.
 
-NOTE: On any operation that may do a fork, any unflushed buffers remain
-unflushed in both processes, which means you may need to set C<$|> to
-avoid duplicate output.  On systems that support a close-on-exec flag on
-files, the flag will be set for the newly opened file descriptor as
-determined by the value of $^F.  See L<perlvar/$^F>.
+NOTE: On any operation that may do a fork, all files opened for output
+are flushed before the fork is attempted.  On systems that support a
+close-on-exec flag on files, the flag will be set for the newly opened
+file descriptor as determined by the value of $^F.  See L<perlvar/$^F>.
 
 Closing any piped filehandle causes the parent process to wait for the
 child to finish, and returns the status value in C<$?>.
diff --git a/pod/perlipc.pod b/pod/perlipc.pod
index 2f99d10e23..1492ccfc31 100644
--- a/pod/perlipc.pod
+++ b/pod/perlipc.pod
@@ -307,8 +307,7 @@ To catch it, you could use this:
 
 Both the main process and any child processes it forks share the same
 STDIN, STDOUT, and STDERR filehandles.  If both processes try to access
-them at once, strange things can happen.  You'll certainly want to any
-stdio flush output buffers before forking.  You may also want to close
+them at once, strange things can happen.  You may also want to close
 or reopen the filehandles for the child.  You can get around this by
 opening your pipe with open(), but on some systems this means that the
 child process cannot outlive the parent.
@@ -473,7 +472,6 @@ Here's an example of using open2():
     use FileHandle;
     use IPC::Open2;
     $pid = open2(*Reader, *Writer, "cat -u -n" );
-    Writer->autoflush(); # default here, actually
     print Writer "stuff\n";
     $got = <Reader>;
 
diff --git a/pp_sys.c b/pp_sys.c
index 73468e1713..9cfb67f999 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3491,6 +3491,7 @@ PP(pp_fork)
     GV *tmpgv;
 
     EXTEND(SP, 1);
+    PERL_FLUSHALL_FOR_CHILD;
     childpid = fork();
     if (childpid < 0)
 	RETSETUNDEF;
@@ -3559,6 +3560,7 @@ PP(pp_system)
 	    TAINT_PROPER("system");
 	}
     }
+    PERL_FLUSHALL_FOR_CHILD;
 #if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2)
     while ((childpid = vfork()) == -1) {
 	if (errno != EAGAIN) {
@@ -3617,6 +3619,7 @@ PP(pp_exec)
     I32 value;
     STRLEN n_a;
 
+    PERL_FLUSHALL_FOR_CHILD;
     if (PL_op->op_flags & OPf_STACKED) {
 	SV *really = *++MARK;
 	value = (I32)do_aexec(really, MARK, SP);
diff --git a/util.c b/util.c
index 2794364d88..31e9c39178 100644
--- a/util.c
+++ b/util.c
@@ -1911,6 +1911,7 @@ my_popen(char *cmd, char *mode)
     SV *sv;
     I32 doexec = strNE(cmd,"-");
 
+    PERL_FLUSHALL_FOR_CHILD;
 #ifdef OS2
     if (doexec) {
 	return my_syspopen(cmd,mode);
@@ -1984,12 +1985,11 @@ my_popen(char *cmd, char *mode)
 #if defined(atarist) || defined(DJGPP)
 FILE *popen();
 PerlIO *
-my_popen(cmd,mode)
-char	*cmd;
-char	*mode;
+my_popen(char *cmd, char *mode)
 {
     /* Needs work for PerlIO ! */
     /* used 0 for 2nd parameter to PerlIO-exportFILE; apparently not used */
+    PERL_FLUSHALL_FOR_CHILD;
     return popen(PerlIO_exportFILE(cmd, 0), mode);
 }
 #endif
diff --git a/vmesa/vmesa.c b/vmesa/vmesa.c
index 11854335e0..0e7894aeb9 100644
--- a/vmesa/vmesa.c
+++ b/vmesa/vmesa.c
@@ -408,6 +408,7 @@ my_popen(char *cmd, char *mode)
          Perl_stdin_fd = pFd[that];
       if (strNE(cmd,"-"))
       {
+	 PERL_FLUSHALL_FOR_CHILD;
          pid = spawn_cmd(cmd, Perl_stdin_fd, Perl_stdout_fd);
          if (pid >= 0)
          {
diff --git a/vms/vms.c b/vms/vms.c
index 6302603486..3e1bc3be3c 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -957,6 +957,7 @@ my_popen(char *cmd, char *mode)
 {
     TAINT_ENV();
     TAINT_PROPER("popen");
+    PERL_FLUSHALL_FOR_CHILD;
     return safe_popen(cmd,mode);
 }
 
diff --git a/win32/win32.c b/win32/win32.c
index b4b208e74d..5e54571d78 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -377,8 +377,7 @@ my_popen(char *cmd, char *mode)
 #define fixcmd(x)
 #endif
     fixcmd(cmd);
-    win32_fflush(stdout);
-    win32_fflush(stderr);
+    PERL_FLUSHALL_FOR_CHILD;
     return win32_popen(cmd, mode);
 }