Absorb #14701 by Sarathy from maint-5.6.

p4raw-id: //depot/perl@14714

diff --git a/doio.c b/doio.c
index 0520992..395553d 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -600,9 +600,16 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            UNLOCK_FDPID_MUTEX;
            (void)SvUPGRADE(sv, SVt_IV);
            SvIVX(sv) = pid;
-           if (!was_fdopen) {
-               PerlIO_close(fp);
+           if (was_fdopen) {
+                /* need to close fp without closing underlying fd */
+                int ofd = PerlIO_fileno(fp);
+                int dupfd = PerlLIO_dup(ofd);
+                PerlIO_close(fp);
+                PerlLIO_dup2(dupfd,ofd);
+                PerlLIO_close(dupfd);
            }
+            else
+               PerlIO_close(fp);
        }
        fp = saveifp;
        PerlIO_clearerr(fp);

diff --git a/t/io/open.t b/t/io/open.t
index cb8aea3..a0f703b 100755 (executable)
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -201,7 +201,6 @@ EOC
 ok( !eval { open local $f, '<&', 'afile'; 1 },  'local <& on non-filehandle');
 like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
 
-
 {
     local *F;
     for (1..2) {
@@ -230,3 +229,41 @@ like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
     is( scalar <$x>, "ok\n",    '       readline' );
     ok( tell($x) >= 3,          '       tell' );
 }
+
+# this used to leak FILE* pointers on all platforms (and also died on
+# Windows after running a few hundred times)
+
+my $devnull = File::Spec->devnull;
+{
+    my $loopcount;
+
+    $loopcount = 0;
+    while ($loopcount++ < 555) {
+       open NEWOUT, ">$devnull" or die;
+       open SAVEOUT, ">&STDOUT" or die;
+       open STDOUT, ">&=" . fileno(NEWOUT) or die;
+       open STDOUT, ">&SAVEOUT" or die;
+       close NEWOUT;
+    }
+    ok;
+
+    $loopcount = 0;
+    while ($loopcount++ < 555) {
+       open NEWOUT, ">$devnull" or die;
+       open SAVEOUT, ">&STDOUT" or die;
+       open STDOUT, ">&=NEWOUT" or die;
+       open STDOUT, ">&SAVEOUT" or die;
+       close NEWOUT;
+    }
+    ok;
+
+    $loopcount = 0;
+    while ($loopcount++ < 555) {
+       open NEWOUT, ">$devnull" or die;
+       open SAVEOUT, ">&STDOUT" or die;
+       open STDOUT, ">&NEWOUT" or die;
+       open STDOUT, ">&SAVEOUT" or die;
+       close NEWOUT;
+    }
+    ok;
+}