Convert all unimaginative (ie race condition) temporary file names to
Nicholas Clark [Fri, 8 Aug 2008 09:59:45 +0000 (09:59 +0000)]
use test.pl's tempfile().

p4raw-id: //depot/perl@34184

t/comp/multiline.t
t/comp/script.t
t/comp/use.t
t/comp/utf.t
t/run/cloexec.t
t/run/runenv.t
t/run/switchC.t
t/run/switchF1.t
t/run/switchd.t
t/run/switches.t
t/run/switcht.t

index e8b7cf4..45771ea 100755 (executable)
@@ -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);
index 6efffdf..83d733a 100755 (executable)
@@ -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`;
index a43bbeb..d3a3568 100755 (executable)
@@ -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;
index f0673eb..6421f93 100644 (file)
@@ -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";
 }
index cfbe702..dfbae3a 100644 (file)
@@ -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);
-}
index 2a73e7c..5012359 100644 (file)
@@ -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;
 
index 082f972..41dba49 100644 (file)
@@ -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' );
 
index fc59645..f94c159 100644 (file)
@@ -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: $!";
 
index e4f2706..921b966 100644 (file)
@@ -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>;$/);
 }
 
index 76dec73..8e1b56c 100644 (file)
@@ -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" );
index f48124e..564b2f3 100644 (file)
@@ -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;