summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2010-01-07 14:22:39 +0000
committerNicholas Clark <nick@ccl4.org>2010-01-07 14:22:39 +0000
commit7299ca586a6a78a40081a6e7e2e94c3b1a8aa538 (patch)
treeebb86caff5956dc6188981de9ab92d9a230cd3f6 /t
parentc1bf414cd50bd38fc03b19662a57f8bcb9008994 (diff)
downloadperl-7299ca586a6a78a40081a6e7e2e94c3b1a8aa538.tar.gz
Unlink PerlIO's tempfiles for the case of no -T, but bogus $ENV{TMPDIR}
When -T is enabled, or when $ENV{TMPDIR} is bogus, perlio.c used a pathname matching </tmp/PerlIO_??????>. However, it was only correctly unlinking the file for the case of -T enabled.
Diffstat (limited to 't')
-rw-r--r--t/io/perlio.t26
1 files changed, 23 insertions, 3 deletions
diff --git a/t/io/perlio.t b/t/io/perlio.t
index 1499ca2802..3a81512c82 100644
--- 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,16 +97,36 @@ 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');
- # hardcoded default temp path
- unlink </tmp/PerlIO_*>;
+ @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 };