Absorb #14701 by Sarathy from maint-5.6.

p4raw-id: //depot/perl@14714

1 files changed, 38 insertions, 1 deletions

diff --git a/t/io/open.t b/t/io/open.t
index cb8aea371f..a0f703b0e7 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;
+}