diff options
author | Nicholas Clark <nick@ccl4.org> | 2010-01-07 14:22:39 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2010-01-07 14:22:39 +0000 |
commit | 7299ca586a6a78a40081a6e7e2e94c3b1a8aa538 (patch) | |
tree | ebb86caff5956dc6188981de9ab92d9a230cd3f6 | |
parent | c1bf414cd50bd38fc03b19662a57f8bcb9008994 (diff) | |
download | perl-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.
-rw-r--r-- | perlio.c | 6 | ||||
-rw-r--r-- | t/io/perlio.t | 26 |
2 files changed, 27 insertions, 5 deletions
@@ -5157,16 +5157,18 @@ PerlIO_tmpfile(void) int fd = -1; char tempname[] = "/tmp/PerlIO_XXXXXX"; const char * const tmpdir = PL_tainting ? NULL : PerlEnv_getenv("TMPDIR"); - SV * const sv = tmpdir && *tmpdir ? newSVpv(tmpdir, 0) : NULL; + SV * sv; /* * I have no idea how portable mkstemp() is ... NI-S */ - if (sv) { + if (tmpdir && *tmpdir) { /* if TMPDIR is set and not empty, we try that first */ + sv = newSVpv(tmpdir, 0); sv_catpv(sv, tempname + 4); fd = mkstemp(SvPVX(sv)); } if (fd < 0) { + sv = NULL; /* else we try /tmp */ fd = mkstemp(tempname); } 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 }; |