Unlink PerlIO's tempfiles for the case of no -T, but bogus $ENV{TMPDIR}

[perl5.git] / t / io / perlio.t

diff --git a/t/io/perlio.t b/t/io/perlio.t
index cdc4c72..3a81512 100644 (file)
--- a/t/io/perlio.t
+++ b/t/io/perlio.t
@@ -9,7 +9,7 @@ BEGIN {
        require './test.pl';
 }
 
-plan tests => 40;
+plan tests => 42;
 
 use_ok('PerlIO');
 
@@ -97,18 +97,41 @@ ok(close($utffh));
         if !$Config{d_mkstemp}
         || $^O eq 'VMS' || $^O eq 'MSwin32' || $^O eq 'os2';
       local $ENV{TMPDIR} = $nonexistent;
+
+      # hardcoded default temp path
+      my $perlio_tmp_file_glob = '/tmp/PerlIO_??????';
+
+      my @before = glob $perlio_tmp_file_glob;
+
       ok( open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to a non-existent dir');
 
+      my @after = glob $perlio_tmp_file_glob;
+      is( "@after", "@before", "No tmp files leaked");
+
+      unlink_new(\@before, \@after);
+
       mkdir $ENV{TMPDIR};
       ok(open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to an existent dir');
+
+      @after = glob $perlio_tmp_file_glob;
+      is( "@after", "@before", "No tmp files leaked");
+
+      unlink_new(\@before, \@after);
     }
 }
 
+sub unlink_new {
+    my ($before, $after) = @_;
+    my %before;
+    @before{@$before} = ();
+    unlink grep {!exists $before{$_}} @$after;
+}
+
 # in-memory open
 SKIP: {
     eval { require PerlIO::scalar };
     unless (find PerlIO::Layer 'scalar') {
-       skip("PerlIO::scalar not found", 8);
+       skip("PerlIO::scalar not found", 9);
     }
     my $var;
     ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');
@@ -142,7 +165,6 @@ SKIP: {
         ok( open(STDERR,">",\$var), '       open STDERR into in-memory var');
         open STDERR,  ">&OLDERR" or die "cannot dup OLDERR: $!";
     }
-}
 
 
 { local $TODO = 'fails well back into 5.8.x';
@@ -168,6 +190,8 @@ close ($perlio);
 close ($no_perlio);
 }
 
+}
+
 
 END {
     1 while unlink $txt;