From 45bc920620377d5a7720d3d562c48df1eb0c2e68 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Sun, 9 May 1999 22:47:39 +0000 Subject: [PATCH] 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 --- perl.h | 8 ++++++++ pod/perldelta.pod | 8 ++++++++ pod/perlfunc.pod | 20 +++++++------------- pod/perlipc.pod | 4 +--- pp_sys.c | 3 +++ util.c | 6 +++--- vmesa/vmesa.c | 1 + vms/vms.c | 1 + win32/win32.c | 3 +-- 9 files changed, 33 insertions(+), 21 deletions(-) diff --git a/perl.h b/perl.h index 8f5082c..febcdf4 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 edef071..9fb0819 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. 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 a65e3e3..4d25fef 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 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, which is more efficient. Note: -C and C do not flush your output buffer, so you may need to -set C<$|> to avoid lost output. Examples: +words and passed directly to C, 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 -method of C to avoid duplicate output. +All files opened for output are flushed before forking the child process. If you C 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 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. +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. 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 2f99d10..1492ccf 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 = ; diff --git a/pp_sys.c b/pp_sys.c index 73468e1..9cfb67f 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 2794364..31e9c39 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 1185433..0e7894a 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 6302603..3e1bc3b 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 b4b208e..5e54571 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); } -- 2.7.4