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 3be0f6a..3a81512 100644 (file)
--- a/t/io/perlio.t
+++ b/t/io/perlio.t
@@ -6,15 +6,17 @@ BEGIN {
            print "1..0 # Skip: PerlIO not used\n";
            exit 0;
        }
+       require './test.pl';
 }
 
-use Test::More tests => 37;
+plan tests => 42;
 
 use_ok('PerlIO');
 
 my $txt = "txt$$";
 my $bin = "bin$$";
 my $utf = "utf$$";
+my $nonexistent = "nex$$";
 
 my $txtfh;
 my $binfh;
@@ -89,10 +91,48 @@ ok(close($utffh));
     # report after STDOUT is restored
     ok($status, '       re-open STDOUT');
     close OLDOUT;
+
+    SKIP: {
+      skip("TMPDIR not honored on this platform", 2)
+        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", 9);
+    }
     my $var;
     ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');
     ok( defined fileno($x),     '       fileno' );
@@ -125,6 +165,31 @@ ok(close($utffh));
         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';
+
+       
+sub read_fh_and_return_final_rv {
+       my ($fh) = @_;
+       my $buf = '';
+       my $rv;
+       for (1..3) {
+               $rv = read($fh, $buf, 1, length($buf));
+               next if $rv;
+       }
+       return $rv
+}
+
+open(my $no_perlio, '<', \'ab') or die; 
+open(my $perlio, '<:crlf', \'ab') or die; 
+
+is(read_fh_and_return_final_rv($perlio), read_fh_and_return_final_rv($no_perlio), "RT#69332 - perlio should return the same value as nonperlio after EOF");
+
+close ($perlio);
+close ($no_perlio);
+}
+
 }
 
 
@@ -132,5 +197,6 @@ END {
     1 while unlink $txt;
     1 while unlink $bin;
     1 while unlink $utf;
+    rmdir $nonexistent;
 }