2d2ad7
From 028f02e7e97a6026ba9ef084c3803ea08d36aa5b Mon Sep 17 00:00:00 2001
2d2ad7
From: Tony Cook <tony@develop-help.com>
2d2ad7
Date: Wed, 1 Aug 2018 11:55:22 +1000
2d2ad7
Subject: [PATCH 1/2] (perl #133314) test for handle leaks from in-place
2d2ad7
 editing
2d2ad7
MIME-Version: 1.0
2d2ad7
Content-Type: text/plain; charset=UTF-8
2d2ad7
Content-Transfer-Encoding: 8bit
2d2ad7
2d2ad7
Signed-off-by: Petr Písař <ppisar@redhat.com>
2d2ad7
---
2d2ad7
 t/io/nargv.t | 46 +++++++++++++++++++++++++++++++++++++++++++++-
2d2ad7
 1 file changed, 45 insertions(+), 1 deletion(-)
2d2ad7
2d2ad7
diff --git a/t/io/nargv.t b/t/io/nargv.t
2d2ad7
index 598ceed617..4482572aeb 100644
2d2ad7
--- a/t/io/nargv.t
2d2ad7
+++ b/t/io/nargv.t
2d2ad7
@@ -6,7 +6,7 @@ BEGIN {
2d2ad7
     set_up_inc('../lib');
2d2ad7
 }
2d2ad7
 
2d2ad7
-print "1..6\n";
2d2ad7
+print "1..7\n";
2d2ad7
 
2d2ad7
 my $j = 1;
2d2ad7
 for $i ( 1,2,5,4,3 ) {
2d2ad7
@@ -84,6 +84,50 @@ sub other {
2d2ad7
     }
2d2ad7
 }
2d2ad7
 
2d2ad7
+{
2d2ad7
+    # (perl #133314) directory handle leak
2d2ad7
+    #
2d2ad7
+    # We process a significant number of files here to make sure any
2d2ad7
+    # leaks are significant
2d2ad7
+    @ARGV = mkfiles(1 .. 10);
2d2ad7
+    for my $file (@ARGV) {
2d2ad7
+        open my $f, ">", $file;
2d2ad7
+        print $f "\n";
2d2ad7
+        close $f;
2d2ad7
+    }
2d2ad7
+    local $^I = ".bak";
2d2ad7
+    local $_;
2d2ad7
+    while (<>) {
2d2ad7
+        s/^/foo/;
2d2ad7
+    }
2d2ad7
+}
2d2ad7
+
2d2ad7
+{
2d2ad7
+    # (perl #133314) directory handle leak
2d2ad7
+    # We open three handles here because the file processing opened:
2d2ad7
+    #  - the original file
2d2ad7
+    #  - the output file, and finally
2d2ad7
+    #  - the directory
2d2ad7
+    # so we need to open the first two to use up the slots used for the original
2d2ad7
+    # and output files.
2d2ad7
+    # This test assumes fd are allocated in the typical *nix way - lowest
2d2ad7
+    # available, which I believe is the case for the Win32 CRTs too.
2d2ad7
+    # If this turns out not to be the case this test will need to skip on
2d2ad7
+    # such platforms or only run on a small set of known-good platforms.
2d2ad7
+    my $tfile = mkfiles(1);
2d2ad7
+    open my $f, "<", $tfile
2d2ad7
+      or die "Cannot open temp: $!";
2d2ad7
+    open my $f2, "<", $tfile
2d2ad7
+      or die "Cannot open temp: $!";
2d2ad7
+    open my $f3, "<", $tfile
2d2ad7
+      or die "Cannot open temp: $!";
2d2ad7
+    print +(fileno($f3) < 20 ? "ok" : "not ok"), " 7 check fd leak\n";
2d2ad7
+    close $f;
2d2ad7
+    close $f2;
2d2ad7
+    close $f3;
2d2ad7
+}
2d2ad7
+
2d2ad7
+
2d2ad7
 my @files;
2d2ad7
 sub mkfiles {
2d2ad7
     foreach (@_) {
2d2ad7
-- 
2d2ad7
2.14.4
2d2ad7