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;
# 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", 8);
+ skip("PerlIO::scalar not found", 9);
}
my $var;
ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');
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);
+}
+
}
1 while unlink $txt;
1 while unlink $bin;
1 while unlink $utf;
+ rmdir $nonexistent;
}