diff options
author | Nicholas Clark <nick@ccl4.org> | 2008-08-08 09:59:45 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2008-08-08 09:59:45 +0000 |
commit | 2d90ac9586ffb5c785730411e7c6e986a8a1190c (patch) | |
tree | 65631403310e339f040a6f18f66ede394a8e48ef | |
parent | 16570ae7eebaecacdda358922298468d022f241d (diff) | |
download | perl-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-x | t/comp/multiline.t | 12 | ||||
-rwxr-xr-x | t/comp/script.t | 10 | ||||
-rwxr-xr-x | t/comp/use.t | 8 | ||||
-rw-r--r-- | t/comp/utf.t | 6 | ||||
-rw-r--r-- | t/run/cloexec.t | 12 | ||||
-rw-r--r-- | t/run/runenv.t | 4 | ||||
-rw-r--r-- | t/run/switchC.t | 9 | ||||
-rw-r--r-- | t/run/switchF1.t | 2 | ||||
-rw-r--r-- | t/run/switchd.t | 9 | ||||
-rw-r--r-- | t/run/switches.t | 34 | ||||
-rw-r--r-- | t/run/switcht.t | 3 |
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; |