summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2008-08-08 09:59:45 +0000
committerNicholas Clark <nick@ccl4.org>2008-08-08 09:59:45 +0000
commit2d90ac9586ffb5c785730411e7c6e986a8a1190c (patch)
tree65631403310e339f040a6f18f66ede394a8e48ef
parent16570ae7eebaecacdda358922298468d022f241d (diff)
downloadperl-2d90ac9586ffb5c785730411e7c6e986a8a1190c.tar.gz
Convert all unimaginative (ie race condition) temporary file names to
use test.pl's tempfile(). p4raw-id: //depot/perl@34184
-rwxr-xr-xt/comp/multiline.t12
-rwxr-xr-xt/comp/script.t10
-rwxr-xr-xt/comp/use.t8
-rw-r--r--t/comp/utf.t6
-rw-r--r--t/run/cloexec.t12
-rw-r--r--t/run/runenv.t4
-rw-r--r--t/run/switchC.t9
-rw-r--r--t/run/switchF1.t2
-rw-r--r--t/run/switchd.t9
-rw-r--r--t/run/switches.t34
-rw-r--r--t/run/switcht.t3
11 files changed, 48 insertions, 61 deletions
diff --git a/t/comp/multiline.t b/t/comp/multiline.t
index e8b7cf4a16..45771ea2f8 100755
--- a/t/comp/multiline.t
+++ b/t/comp/multiline.t
@@ -8,7 +8,8 @@ BEGIN {
plan(tests => 6);
-open(TRY,'>Comp.try') || (die "Can't open temp file.");
+my $filename = tempfile();
+open(TRY,'>',$filename) || (die "Can't open $filename: $!");
$x = 'now is the time
for all good men
@@ -28,7 +29,7 @@ is($x, $y, 'test data is sane');
print TRY $x;
close TRY or die "Could not close: $!";
-open(TRY,'Comp.try') || (die "Can't reopen temp file.");
+open(TRY,$filename) || (die "Can't reopen $filename: $!");
$count = 0;
$z = '';
while (<TRY>) {
@@ -42,12 +43,11 @@ is($count, 7, ' line count');
is($., 7, ' $.' );
$out = (($^O eq 'MSWin32') || $^O eq 'NetWare' || $^O eq 'VMS') ? `type Comp.try`
- : ($^O eq 'MacOS') ? `catenate Comp.try`
- : `cat Comp.try`;
+ : ($^O eq 'MacOS') ? `catenate $filename`
+ : `cat $filename`;
like($out, qr/.*\n.*\n.*\n$/);
-close(TRY) || (die "Can't close temp file.");
-unlink 'Comp.try' || `/bin/rm -f Comp.try`;
+close(TRY) || (die "Can't close $filename: $!");
is($out, $y);
diff --git a/t/comp/script.t b/t/comp/script.t
index 6efffdf81a..83d733abd2 100755
--- a/t/comp/script.t
+++ b/t/comp/script.t
@@ -8,22 +8,22 @@ BEGIN {
my $Perl = which_perl();
+my $filename = tempfile();
+
print "1..3\n";
$x = `$Perl -le "print 'ok';"`;
if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
-open(try,">Comp.script") || (die "Can't open temp file.");
+open(try,">$filename") || (die "Can't open temp file.");
print try 'print "ok\n";'; print try "\n";
close try or die "Could not close: $!";
-$x = `$Perl Comp.script`;
+$x = `$Perl $filename`;
if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
-$x = `$Perl <Comp.script`;
+$x = `$Perl <$filename`;
if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
-
-unlink 'Comp.script' || `/bin/rm -f Comp.script`;
diff --git a/t/comp/use.t b/t/comp/use.t
index a43bbeb44c..d3a3568c1c 100755
--- a/t/comp/use.t
+++ b/t/comp/use.t
@@ -190,12 +190,12 @@ if ($^O eq 'MacOS') {
{
# Regression test for patch 14937:
# Check that a .pm file with no package or VERSION doesn't core.
- open F, ">xxx.pm" or die "Cannot open xxx.pm: $!\n";
+ open F, ">xxx$$.pm" or die "Cannot open xxx$$.pm: $!\n";
print F "1;\n";
close F;
- eval "use lib '.'; use xxx 3;";
- like ($@, qr/^xxx defines neither package nor VERSION--version check failed at/);
- unlink 'xxx.pm';
+ eval "use lib '.'; use xxx$$ 3;";
+ like ($@, qr/^xxx$$ defines neither package nor VERSION--version check failed at/);
+ unlink "xxx$$.pm";
}
my @ver = split /\./, sprintf "%vd", $^V;
diff --git a/t/comp/utf.t b/t/comp/utf.t
index f0673eb964..6421f9330d 100644
--- a/t/comp/utf.t
+++ b/t/comp/utf.t
@@ -26,12 +26,12 @@ my $BOM = chr(0xFEFF);
sub test {
my ($enc, $tag, $bom) = @_;
- open(UTF_PL, ">:raw:encoding($enc)", "utf.pl")
+ open(UTF_PL, ">:raw:encoding($enc)", "utf$$.pl")
or die "utf.pl($enc,$tag,$bom): $!";
print UTF_PL $BOM if $bom;
print UTF_PL "$tag\n";
close(UTF_PL);
- my $got = do "./utf.pl";
+ my $got = do "./utf$$.pl";
is($got, $tag);
}
@@ -53,5 +53,5 @@ test("utf16be", 1234, 0);
test("utf16be", 12345, 0);
END {
- 1 while unlink "utf.pl";
+ 1 while unlink "utf$$.pl";
}
diff --git a/t/run/cloexec.t b/t/run/cloexec.t
index cfbe702a08..dfbae3ad9c 100644
--- a/t/run/cloexec.t
+++ b/t/run/cloexec.t
@@ -67,9 +67,9 @@ sub make_tmp_file {
my $Perl = which_perl();
my $quote = $Is_VMS || $Is_Win32 ? '"' : "'";
-my $tmperr = 'cloexece.tmp';
-my $tmpfile1 = 'cloexec1.tmp';
-my $tmpfile2 = 'cloexec2.tmp';
+my $tmperr = tempfile();
+my $tmpfile1 = tempfile();
+my $tmpfile2 = tempfile();
my $tmpfile1_contents = "tmpfile1 line 1\ntmpfile1 line 2\n";
my $tmpfile2_contents = "tmpfile2 line 1\ntmpfile2 line 2\n";
make_tmp_file($tmpfile1, $tmpfile1_contents);
@@ -164,9 +164,3 @@ cmp_ok( $parentfd1, '<=', $^F, "parent open fd=$parentfd1 (\$^F=$^F)" );
test_inherited($parentfd1);
close FHPARENT1 or die "close '$tmpfile1': $!";
close FHPARENT2 or die "close '$tmpfile2': $!";
-
-END {
- defined $tmperr and unlink($tmperr);
- defined $tmpfile1 and unlink($tmpfile1);
- defined $tmpfile2 and unlink($tmpfile2);
-}
diff --git a/t/run/runenv.t b/t/run/runenv.t
index 2a73e7c400..5012359792 100644
--- a/t/run/runenv.t
+++ b/t/run/runenv.t
@@ -17,8 +17,8 @@ BEGIN {
plan tests => 17;
-my $STDOUT = './results-0';
-my $STDERR = './results-1';
+my $STDOUT = tempfile();
+my $STDERR = tempfile();
my $PERL = $ENV{PERL} || './perl';
my $FAILURE_CODE = 119;
diff --git a/t/run/switchC.t b/t/run/switchC.t
index 082f972b7f..41dba4988f 100644
--- a/t/run/switchC.t
+++ b/t/run/switchC.t
@@ -17,8 +17,7 @@ plan(tests => 6);
my $r;
-my @tmpfiles = ();
-END { unlink @tmpfiles }
+my $tmpfile = tempfile();
my $b = pack("C*", unpack("U0C*", pack("U",256)));
@@ -45,14 +44,12 @@ $r = runperl( switches => [ '-CE', '-w' ],
like( $r, qr/^$b(?:\r?\n)?$/s, '-CE: UTF-8 stderr' );
$r = runperl( switches => [ '-Co', '-w' ],
- prog => 'open(F, q(>out)); print F chr(256); close F',
+ prog => "open(F, q(>$tmpfile)); print F chr(256); close F",
stderr => 1 );
like( $r, qr/^$/s, '-Co: auto-UTF-8 open for output' );
-push @tmpfiles, "out";
-
$r = runperl( switches => [ '-Ci', '-w' ],
- prog => 'open(F, q(<out)); print ord(<F>); close F',
+ prog => "open(F, q(<$tmpfile)); print ord(<F>); close F",
stderr => 1 );
like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input' );
diff --git a/t/run/switchF1.t b/t/run/switchF1.t
index fc59645646..f94c159544 100644
--- a/t/run/switchF1.t
+++ b/t/run/switchF1.t
@@ -1,7 +1,7 @@
#!perl -w
print "1..5\n";
-my $file = "F-Pathological.pl";
+my $file = "Run_switchF1.pl";
open F, ">$file" or die "Open $file: $!";
diff --git a/t/run/switchd.t b/t/run/switchd.t
index e4f27068b9..921b966073 100644
--- a/t/run/switchd.t
+++ b/t/run/switchd.t
@@ -12,10 +12,8 @@ BEGIN { require "./test.pl"; }
plan(tests => 2);
my $r;
-my @tmpfiles = ();
-END { unlink @tmpfiles }
-my $filename = 'swdtest.tmp';
+my $filename = tempfile();
SKIP: {
open my $f, ">$filename"
or skip( "Can't write temp file $filename: $!" );
@@ -31,19 +29,18 @@ package main;
Foo::foo(3);
__SWDTEST__
close $f;
- push @tmpfiles, $filename;
$| = 1; # Unbufferize.
$r = runperl(
switches => [ '-Ilib', '-f', '-d:switchd' ],
progfile => $filename,
args => ['3'],
);
- like($r, qr/^sub<Devel::switchd::import>;import<Devel::switchd>;DB<main,swdtest.tmp,9>;sub<Foo::foo>;DB<Foo,swdtest.tmp,5>;DB<Foo,swdtest.tmp,6>;DB<Foo,swdtest.tmp,6>;sub<Bar::bar>;DB<Bar,swdtest.tmp,2>;sub<Bar::bar>;DB<Bar,swdtest.tmp,2>;sub<Bar::bar>;DB<Bar,swdtest.tmp,2>;$/);
+ like($r, qr/^sub<Devel::switchd::import>;import<Devel::switchd>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/);
$r = runperl(
switches => [ '-Ilib', '-f', '-d:switchd=a,42' ],
progfile => $filename,
args => ['4'],
);
- like($r, qr/^sub<Devel::switchd::import>;import<Devel::switchd a 42>;DB<main,swdtest.tmp,9>;sub<Foo::foo>;DB<Foo,swdtest.tmp,5>;DB<Foo,swdtest.tmp,6>;DB<Foo,swdtest.tmp,6>;sub<Bar::bar>;DB<Bar,swdtest.tmp,2>;sub<Bar::bar>;DB<Bar,swdtest.tmp,2>;sub<Bar::bar>;DB<Bar,swdtest.tmp,2>;$/);
+ like($r, qr/^sub<Devel::switchd::import>;import<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/);
}
diff --git a/t/run/switches.t b/t/run/switches.t
index 76dec739f1..8e1b56c7fe 100644
--- a/t/run/switches.t
+++ b/t/run/switches.t
@@ -76,7 +76,7 @@ is( $r, "(\066)[\066]", '$/ set at compile-time' );
# Tests for -c
-my $filename = 'swctest.tmp';
+my $filename = tempfile();
SKIP: {
local $TODO = ''; # this one works on VMS
@@ -105,7 +105,6 @@ SWTEST
&& $r !~ /\bblock 5\b/,
'-c'
);
- push @tmpfiles, $filename;
}
# Tests for -l
@@ -125,7 +124,7 @@ $r = runperl(
);
is( $r, '21-', '-s switch parsing' );
-$filename = 'swstest.tmp';
+$filename = tempfile();
SKIP: {
open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
print $f <<'SWTEST';
@@ -138,11 +137,10 @@ SWTEST
args => [ '-x=foo -y' ],
);
is( $r, 'foo1', '-s on the shebang line' );
- push @tmpfiles, $filename;
}
# Bug ID 20011106.084
-$filename = 'swsntest.tmp';
+$filename = tempfile();
SKIP: {
open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
print $f <<'SWTEST';
@@ -155,32 +153,32 @@ SWTEST
args => [ '-x=foo' ],
);
is( $r, 'foo', '-sn on the shebang line' );
- push @tmpfiles, $filename;
}
# Tests for -m and -M
-$filename = 'swtest.pm';
+my $package = tempfile();
+$filename = "$package.pm";
SKIP: {
open my $f, ">$filename" or skip( "Can't write temp file $filename: $!",4 );
- print $f <<'SWTESTPM';
-package swtest;
-sub import { print map "<$_>", @_ }
+ print $f <<"SWTESTPM";
+package $package;
+sub import { print map "<\$_>", \@_ }
1;
SWTESTPM
close $f or die "Could not close: $!";
$r = runperl(
- switches => [ '-Mswtest' ],
+ switches => [ "-M$package" ],
prog => '1',
);
- is( $r, '<swtest>', '-M' );
+ is( $r, "<$package>", '-M' );
$r = runperl(
- switches => [ '-Mswtest=foo' ],
+ switches => [ "-M$package=foo" ],
prog => '1',
);
- is( $r, '<swtest><foo>', '-M with import parameter' );
+ is( $r, "<$package><foo>", '-M with import parameter' );
$r = runperl(
- switches => [ '-mswtest' ],
+ switches => [ "-m$package" ],
prog => '1',
);
@@ -189,16 +187,16 @@ SWTESTPM
is( $r, '', '-m' );
}
$r = runperl(
- switches => [ '-mswtest=foo,bar' ],
+ switches => [ "-m$package=foo,bar" ],
prog => '1',
);
- is( $r, '<swtest><foo><bar>', '-m with import parameters' );
+ is( $r, "<$package><foo><bar>", '-m with import parameters' );
push @tmpfiles, $filename;
is( runperl( switches => [ '-MTie::Hash' ], stderr => 1, prog => 1 ),
'', "-MFoo::Bar allowed" );
- like( runperl( switches => [ '-M:swtest' ], stderr => 1,
+ like( runperl( switches => [ "-M:$package" ], stderr => 1,
prog => 'die "oops"' ),
qr/Invalid module name [\w:]+ with -M option\b/,
"-M:Foo not allowed" );
diff --git a/t/run/switcht.t b/t/run/switcht.t
index f48124e70d..564b2f3671 100644
--- a/t/run/switcht.t
+++ b/t/run/switcht.t
@@ -29,8 +29,9 @@ like( $warning, qr/^Insecure .* $Tmsg/, ' taint warn' );
}
# Get ourselves a tainted variable.
+my $filename = tempfile();
$file = $0;
-$file =~ s/.*/some.tmp/;
+$file =~ s/.*/$filename/;
ok( open(FILE, ">$file"), 'open >' ) or DIE $!;
print FILE "Stuff\n";
close FILE;