From: Abhijit Menon-Sen <ams@wiw.org>
Date: Sat, 16 Feb 2002 02:43:59 +0000 (+0000)
Subject:    Absorb #14701 by Sarathy from maint-5.6.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e212fc47535368d2c67d798e231108ada401dee1;p=p5sagit%2Fp5-mst-13.2.git

   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
--- 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
--- 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;
+}