Use test.pl's tempfile().

p4raw-id: //depot/perl@34180

diff --git a/t/op/closure.t b/t/op/closure.t
index d1cab95..5e3bf45 100755 (executable)
--- a/t/op/closure.t
+++ b/t/op/closure.t
@@ -463,9 +463,8 @@ END
            }
          } else {
            # No fork().  Do it the hard way.
-           my $cmdfile = "tcmd$$";  $cmdfile++ while -e $cmdfile;
-           my $errfile = "terr$$";  $errfile++ while -e $errfile;
-           my @tmpfiles = ($cmdfile, $errfile);
+           my $cmdfile = tempfile();
+           my $errfile = tempfile();
            open CMD, ">$cmdfile"; print CMD $code; close CMD;
            my $cmd = which_perl();
            $cmd .= " -w $cmdfile 2>$errfile";
@@ -477,18 +476,15 @@ END
              { local $/; $output = join '', <PERL> }
              close PERL;
            } else {
-             my $outfile = "tout$$";  $outfile++ while -e $outfile;
-             push @tmpfiles, $outfile;
+             my $outfile = tempfile();
              system "$cmd >$outfile";
              { local $/; open IN, $outfile; $output = <IN>; close IN }
            }
            if ($?) {
              printf "not ok: exited with error code %04X\n", $?;
-             $debugging or do { 1 while unlink @tmpfiles };
              exit;
            }
            { local $/; open IN, $errfile; $errors = <IN>; close IN }
-           1 while unlink @tmpfiles;
          }
          print $output;
          print STDERR $errors;

diff --git a/t/op/dbm.t b/t/op/dbm.t
index e6545fa..2403370 100644 (file)
--- a/t/op/dbm.t
+++ b/t/op/dbm.t
@@ -13,38 +13,43 @@ plan tests => 4;
 
 # This is [20020104.007] "coredump on dbmclose"
 
+my $filename = tempfile();
+
 my $prog = <<'EOC';
 package Foo;
+$filename = '@@@@';
 sub new {
         my $proto = shift;
         my $class = ref($proto) || $proto;
         my $self  = {};
         bless($self,$class);
         my %LT;
-        dbmopen(%LT, "dbmtest", 0666) ||
-           die "Can't open dbmtest because of $!\n";
+        dbmopen(%LT, $filename, 0666) ||
+           die "Can't open $filename because of $!\n";
         $self->{'LT'} = \%LT;
         return $self;
 }
 sub DESTROY {
         my $self = shift;
        dbmclose(%{$self->{'LT'}});
-       1 while unlink 'dbmtest';
-       1 while unlink <dbmtest.*>;
+       1 while unlink $filename;
+       1 while unlink glob "$filename.*";
        print "ok\n";
 }
 package main;
 $test = Foo->new(); # must be package var
 EOC
 
+$prog =~ s/\@\@\@\@/$filename/;
+
 fresh_perl_is("require AnyDBM_File;\n$prog", 'ok', {}, 'explict require');
 fresh_perl_is($prog, 'ok', {}, 'implicit require');
 
 $prog = <<'EOC';
 @INC = ();
-dbmopen(%LT, "dbmtest", 0666);
-1 while unlink 'dbmtest';
-1 while unlink <dbmtest.*>;
+dbmopen(%LT, $filename, 0666);
+1 while unlink $filename;
+1 while unlink glob "$filename.*";
 die "Failed to fail!";
 EOC
 

diff --git a/t/op/eval.t b/t/op/eval.t
index d3241e6..23725d5 100755 (executable)
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -3,6 +3,7 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
 print "1..98\n";
@@ -38,11 +39,12 @@ $fact = 'local($foo)=$foo; $foo <= 1 ? 1 : $foo-- * (eval $fact);';
 $ans = eval $fact;
 if ($ans == 120) {print "ok 9\n";} else {print "not ok 9 $ans\n";}
 
-open(try,'>Op.eval');
-print try 'print "ok 10\n"; unlink "Op.eval";',"\n";
+my $tempfile = tempfile();
+open(try,'>',$tempfile);
+print try 'print "ok 10\n";',"\n";
 close try;
 
-do './Op.eval'; print $@;
+do "./$tempfile"; print $@;
 
 # Test the singlequoted eval optimizer
 
@@ -500,15 +502,16 @@ print "ok $test # length of \$@ after eval\n"; $test++;
 
 # Check if eval { 1 }; compeltly resets $@
 if (eval "use Devel::Peek; 1;") {
-  
-  open PROG, ">", "peek_eval_$$.t" or die "Can't create test file";
-  print PROG <<'END_EVAL_TEST';
+  $tempfile = tempfile();
+  $outfile = tempfile();
+  open PROG, ">", $tempfile or die "Can't create test file";
+  my $prog = <<'END_EVAL_TEST';
     use Devel::Peek;
     $! = 0;
     $@ = $!;
     my $ok = 0;
     open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
-    if (open(OUT,">peek_eval$$")) {
+    if (open(OUT, '>', '@@@@')) {
       open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
       Dump($@);
       print STDERR "******\n";
@@ -518,7 +521,7 @@ if (eval "use Devel::Peek; 1;") {
       Dump($@);
       open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
       close(OUT);
-      if (open(IN, "peek_eval$$")) {
+      if (open(IN, '<', '@@@@')) {
         local $/;
         my $in = <IN>;
         my ($first, $second) = split (/\*\*\*\*\*\*\n/, $in, 2);
@@ -528,18 +531,16 @@ if (eval "use Devel::Peek; 1;") {
     }
 
     print $ok;
-    END {
-      1 while unlink("peek_eval$$");
-    }
 END_EVAL_TEST
+    $prog =~ s/\@\@\@\@/$outfile/g;
+    print PROG $prog;
    close PROG;
 
-   my $ok = runperl(progfile => "peek_eval_$$.t");
+   my $ok = runperl(progfile => $tempfile);
    print "not " unless $ok;
    print "ok $test # eval { 1 } completly resets \$@\n";
 
    $test++;
-   1 while unlink("peek_eval_$$.t");
 }
 else {
   print "ok $test # skipped - eval { 1 } completly resets \$@";

diff --git a/t/op/fork.t b/t/op/fork.t
index a19b260..9fe8107 100755 (executable)
--- a/t/op/fork.t
+++ b/t/op/fork.t
@@ -11,6 +11,7 @@ BEGIN {
        exit 0;
     }
     $ENV{PERL5LIB} = "../lib";
+    require './test.pl';
 }
 
 if ($^O eq 'mpeix') {
@@ -24,9 +25,8 @@ undef $/;
 @prgs = split "\n########\n", <DATA>;
 print "1..", scalar @prgs, "\n";
 
-$tmpfile = "forktmp000";
-1 while -f ++$tmpfile;
-END { close TEST; unlink $tmpfile if $tmpfile; }
+$tmpfile = tempfile();
+END { close TEST }
 
 $CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : (($^O eq 'NetWare') ? 'perl -e "print <>"' : 'cat'));
 
@@ -54,8 +54,8 @@ for (@prgs){
     }
     $status = $?;
     $results =~ s/\n+$//;
-    $results =~ s/at\s+forktmp\d+\s+line/at - line/g;
-    $results =~ s/of\s+forktmp\d+\s+aborted/of - aborted/g;
+    $results =~ s/at\s+$::tempfile_regexp\s+line/at - line/g;
+    $results =~ s/of\s+$::tempfile_regexp\s+aborted/of - aborted/g;
 # bison says 'parse error' instead of 'syntax error',
 # various yaccs may or may not capitalize 'syntax'.
     $results =~ s/^(syntax|parse) error/syntax error/mig;

diff --git a/t/op/goto.t b/t/op/goto.t
index 9254d7c..c79b424 100755 (executable)
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -205,7 +205,7 @@ is($ok, 1, 'goto in for(;;) with continuation');
 
 # bug #22299 - goto in require doesn't find label
 
-open my $f, ">goto01.pm" or die;
+open my $f, ">Op_goto01.pm" or die;
 print $f <<'EOT';
 package goto01;
 goto YYY;
@@ -215,9 +215,9 @@ YYY: print "OK\n";
 EOT
 close $f;
 
-$r = runperl(prog => 'use goto01; print qq[DONE\n]');
+$r = runperl(prog => 'use Op_goto01; print qq[DONE\n]');
 is($r, "OK\nDONE\n", "goto within use-d file"); 
-unlink "goto01.pm";
+unlink "Op_goto01.pm";
 
 # test for [perl #24108]
 $ok = 1;

diff --git a/t/op/inccode.t b/t/op/inccode.t
index 45022ff..60c3581 100644 (file)
--- a/t/op/inccode.t
+++ b/t/op/inccode.t
@@ -25,12 +25,8 @@ use File::Spec;
 require "test.pl";
 plan(tests => 49 + !$minitest * (3 + 14 * $can_fork));
 
-my @tempfiles = ();
-
 sub get_temp_fh {
-    my $f = "DummyModule0000";
-    1 while -e ++$f;
-    push @tempfiles, $f;
+    my $f = tempfile();
     open my $fh, ">$f" or die "Can't create $f: $!";
     print $fh "package ".substr($_[0],0,-3).";\n1;\n";
     print $fh $_[1] if @_ > 1;
@@ -39,8 +35,6 @@ sub get_temp_fh {
     return $fh;
 }
 
-END { 1 while unlink @tempfiles }
-
 sub fooinc {
     my ($self, $filename) = @_;
     if (substr($filename,0,3) eq 'Foo') {

diff --git a/t/op/lfs.t b/t/op/lfs.t
index 8f022b8..2de965f 100644 (file)
--- a/t/op/lfs.t
+++ b/t/op/lfs.t
@@ -11,6 +11,7 @@ BEGIN {
                print "1..0 # Skip: no 64-bit file offsets\n";
                exit(0);
        }
+       require './test.pl';
 }
 
 use strict;
@@ -18,11 +19,12 @@ use strict;
 our @s;
 our $fail;
 
+my $big0 = tempfile();
+my $big1 = tempfile();
+my $big2 = tempfile();
+
 sub zap {
     close(BIG);
-    unlink("big");
-    unlink("big1");
-    unlink("big2");
 }
 
 sub bye {
@@ -82,33 +84,33 @@ my ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2);
 # consume less blocks than one megabyte (assuming nobody has
 # one megabyte blocks...)
 
-open(BIG, ">big1") or
-    do { warn "open big1 failed: $!\n"; bye };
+open(BIG, ">$big1") or
+    do { warn "open $big1 failed: $!\n"; bye };
 binmode(BIG) or
-    do { warn "binmode big1 failed: $!\n"; bye };
+    do { warn "binmode $big1 failed: $!\n"; bye };
 seek(BIG, 1_000_000, $SEEK_SET) or
-    do { warn "seek big1 failed: $!\n"; bye };
+    do { warn "seek $big1 failed: $!\n"; bye };
 print BIG "big" or
-    do { warn "print big1 failed: $!\n"; bye };
+    do { warn "print $big1 failed: $!\n"; bye };
 close(BIG) or
-    do { warn "close big1 failed: $!\n"; bye };
+    do { warn "close $big1 failed: $!\n"; bye };
 
-my @s1 = stat("big1");
+my @s1 = stat($big1);
 
 print "# s1 = @s1\n";
 
-open(BIG, ">big2") or
-    do { warn "open big2 failed: $!\n"; bye };
+open(BIG, ">$big2") or
+    do { warn "open $big2 failed: $!\n"; bye };
 binmode(BIG) or
-    do { warn "binmode big2 failed: $!\n"; bye };
+    do { warn "binmode $big2 failed: $!\n"; bye };
 seek(BIG, 2_000_000, $SEEK_SET) or
-    do { warn "seek big2 failed; $!\n"; bye };
+    do { warn "seek $big2 failed; $!\n"; bye };
 print BIG "big" or
-    do { warn "print big2 failed; $!\n"; bye };
+    do { warn "print $big2 failed; $!\n"; bye };
 close(BIG) or
-    do { warn "close big2 failed; $!\n"; bye };
+    do { warn "close $big2 failed; $!\n"; bye };
 
-my @s2 = stat("big2");
+my @s2 = stat($big2);
 
 print "# s2 = @s2\n";
 
@@ -129,13 +131,13 @@ print "# we seem to have sparse files...\n";
 $ENV{LC_ALL} = "C";
 
 my $r = system '../perl', '-e', <<'EOF';
-open(BIG, ">big");
+open(BIG, ">$big0");
 seek(BIG, 5_000_000_000, 0);
-print BIG "big";
+print BIG $big0;
 exit 0;
 EOF
 
-open(BIG, ">big") or do { warn "open failed: $!\n"; bye };
+open(BIG, ">$big0") or do { warn "open failed: $!\n"; bye };
 binmode BIG;
 if ($r or not seek(BIG, 5_000_000_000, $SEEK_SET)) {
     my $err = $r ? 'signal '.($r & 0x7f) : $!;
@@ -160,7 +162,7 @@ unless ($print && $close) {
     bye();
 }
 
-@s = stat("big");
+@s = stat($big0);
 
 print "# @s\n";
 
@@ -169,7 +171,7 @@ unless ($s[7] == 5_000_000_003) {
     bye();
 }
 
-sub fail () {
+sub fail {
     print "not ";
     $fail++;
 }
@@ -202,16 +204,16 @@ $fail = 0;
 fail unless $s[7] == 5_000_000_003;    # exercizes pp_stat
 print "ok 1\n";
 
-fail unless -s "big" == 5_000_000_003; # exercizes pp_ftsize
+fail unless -s $big0 == 5_000_000_003; # exercizes pp_ftsize
 print "ok 2\n";
 
-fail unless -e "big";
+fail unless -e $big0;
 print "ok 3\n";
 
-fail unless -f "big";
+fail unless -f $big0;
 print "ok 4\n";
 
-open(BIG, "big") or do { warn "open failed: $!\n"; bye };
+open(BIG, $big0) or do { warn "open failed: $!\n"; bye };
 binmode BIG;
 
 fail unless seek(BIG, 4_500_000_000, $SEEK_SET);
@@ -270,9 +272,8 @@ bye(); # does the necessary cleanup
 END {
     # unlink may fail if applied directly to a large file
     # be paranoid about leaving 5 gig files lying around
-    open(BIG, ">big"); # truncate
+    open(BIG, ">$big0"); # truncate
     close(BIG);
-    1 while unlink "big"; # standard portable idiom
 }
 
 # eof

diff --git a/t/op/mydef.t b/t/op/mydef.t
index f250ff6..444bf4a 100644 (file)
--- a/t/op/mydef.t
+++ b/t/op/mydef.t
@@ -3,12 +3,13 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
 print "1..70\n";
 
 my $test = 0;
-sub ok ($$) {
+sub ok ($@) {
     my ($ok, $name) = @_;
     ++$test;
     print $ok ? "ok $test - $name\n" : "not ok $test - $name\n";
@@ -175,8 +176,7 @@ $_ = "global";
     ::ok( $1 eq 'notmain', '...m// defaults to our $_ in main::' );
 }
 
-my $file = 'dolbar1.tmp';
-END { unlink $file; }
+my $file = tempfile();
 {
     open my $_, '>', $file or die "Can't open $file: $!";
     print $_ "hello\n";

diff --git a/t/op/read.t b/t/op/read.t
index 8235bc2..23f1b51 100755 (executable)
--- a/t/op/read.t
+++ b/t/op/read.t
@@ -31,9 +31,7 @@ my $has_perlio = !eval {
     !$Config::Config{useperlio}
 };
 
-my $tmpfile = 'Op_read.tmp';
-
-END { 1 while unlink $tmpfile }
+my $tmpfile = tempfile();
 
 my (@values, @buffers) = ('', '');
 
@@ -56,7 +54,6 @@ foreach my $value (@values) {
            skip "Needs :utf8 layer but no perlio", 2 * @offsets * @lengths
              if $utf8 and !$has_perlio;
 
-           1 while unlink $tmpfile;
            open FH, ">$tmpfile" or die "Can't open $tmpfile: $!";
            binmode FH, "utf8" if $utf8;
            print FH $value;

diff --git a/t/op/readline.t b/t/op/readline.t
index 0d6598f..1069a97 100644 (file)
--- a/t/op/readline.t
+++ b/t/op/readline.t
@@ -12,11 +12,11 @@ eval { for (\2) { $_ = <FH> } };
 like($@, 'Modification of a read-only value attempted', '[perl #19566]');
 
 {
-  open A,"+>a"; $a = 3;
+  my $file = tempfile();
+  open A,'+>',$file; $a = 3;
   is($a .= <A>, 3, '#21628 - $a .= <A> , A eof');
   close A; $a = 4;
   is($a .= <A>, 4, '#21628 - $a .= <A> , A closed');
-  unlink "a";
 }
 
 # 82 is chosen to exceed the length for sv_grow in do_readline (80)

diff --git a/t/op/runlevel.t b/t/op/runlevel.t
index 36c63ef..c103812 100755 (executable)
--- a/t/op/runlevel.t
+++ b/t/op/runlevel.t
@@ -8,6 +8,7 @@
 
 chdir 't' if -d 't';
 @INC = '../lib';
+require './test.pl';
 $Is_VMS = $^O eq 'VMS';
 $Is_MSWin32 = $^O eq 'MSWin32';
 $Is_NetWare = $^O eq 'NetWare';
@@ -20,9 +21,7 @@ undef $/;
 @prgs = split "\n########\n", <DATA>;
 print "1..", scalar @prgs, "\n";
 
-$tmpfile = "runltmp000";
-1 while -f ++$tmpfile;
-END { if ($tmpfile) { 1 while unlink $tmpfile; } }
+$tmpfile = tempfile();
 
 for (@prgs){
     my $switch = "";
@@ -45,7 +44,7 @@ for (@prgs){
     my $status = $?;
     $results =~ s/\n+$//;
     # allow expected output to be written as if $prog is on STDIN
-    $results =~ s/runltmp\d+/-/g;
+    $results =~ s/$::tempfile_regexp/-/g;
     $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
     $expected =~ s/\n+$//;
     if ($results ne $expected) {

diff --git a/t/op/stat.t b/t/op/stat.t
index d238855..a225de4 100755 (executable)
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -38,8 +38,8 @@ my($DEV, $INO, $MODE, $NLINK, $UID, $GID, $RDEV, $SIZE,
 my $Curdir = File::Spec->curdir;
 
 
-my $tmpfile = 'Op_stat.tmp';
-my $tmpfile_link = $tmpfile.'2';
+my $tmpfile = tempfile();
+my $tmpfile_link = tempfile();
 
 chmod 0666, $tmpfile;
 1 while unlink $tmpfile;

diff --git a/t/op/taint.t b/t/op/taint.t
index b2688cf..f578423 100755 (executable)
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -285,7 +285,7 @@ my $TEST = catfile(curdir(), 'TEST');
 # How about command-line arguments? The problem is that we don't
 # always get some, so we'll run another process with some.
 SKIP: {
-    my $arg = catfile(curdir(), "arg$$");
+    my $arg = catfile(curdir(), tempfile());
     open PROG, "> $arg" or die "Can't create $arg: $!";
     print PROG q{
        eval { join('', @ARGV), kill 0 };
@@ -418,8 +418,7 @@ SKIP: {
     test !eval { require $foo }, 'require';
     test $@ =~ /^Insecure dependency/, $@;
 
-    my $filename = "./taintB$$";       # NB: $filename isn't tainted!
-    END { unlink $filename if defined $filename }
+    my $filename = tempfile(); # NB: $filename isn't tainted!
     $foo = $filename . $TAINT;
     unlink $filename;  # in any case
 
@@ -506,8 +505,7 @@ SKIP: {
        my $foo = "x" x 979;
        taint_these $foo;
        local *FOO;
-       my $temp = "./taintC$$";
-       END { unlink $temp }
+       my $temp = tempfile();
        test open(FOO, "> $temp"), "Couldn't open $temp for write: $!";
 
        test !eval { ioctl FOO, $TAINT0, $foo }, 'ioctl';