Integrate:
authorBram <perl-rt@wizbit.be>
Sun, 10 Aug 2008 20:36:27 +0000 (22:36 +0200)
committerNicholas Clark <nick@ccl4.org>
Fri, 5 Sep 2008 13:59:17 +0000 (13:59 +0000)
[ 34180]
Use test.pl's tempfile().

[ 34182]
Convert all unimaginative (ie race condition) temporary file names to
use test.pl's tempfile().

[ 34184]
Convert all unimaginative (ie race condition) temporary file names to
use test.pl's tempfile().

[ 34196]
Subject: Avoid a potential testing race condition in lib/Dirhandle.ttest.
Message-ID: <20080810203627.vj786wb688skc44w@horde.wizbit.be>
Date: Sun, 10 Aug 2008 20:36:27 +0200

[ 34203]
VMS-specific follow-up to tempfile name changes in 34182, plus
a TODO in dup.t that's long since to-done.

[ 34205]
Subject: [PATCH] Re: Change 34184: Convert all unimaginative (ie race condition) temporary file names to
From: Bram <p5p@perl.wizbit.be>
Date: Tue, 12 Aug 2008 19:05:00 +0200
Message-ID: <20080812190500.3ns5yf7ibocgo0w0@horde.wizbit.be>

(Change 34184 missed one Comp.try in the MSWin32 case, which caused this
test to fail on Win32)
p4raw-link: @34205 on //depot/perl: 06d90eb2f694021a5def99acedeffe3d57873a83
p4raw-link: @34203 on //depot/perl: 7aa55bb4d7409fae441c5fde09543172f4df350d
p4raw-link: @34196 on //depot/perl: ffe4764e6903def60304ff584612fb863707cd05
p4raw-link: @34184 on //depot/perl: 2d90ac9586ffb5c785730411e7c6e986a8a1190c
p4raw-link: @34182 on //depot/perl: 62a28c976c312a2c7269acc71060b1037a453bea
p4raw-link: @34180 on //depot/perl: 1c25d394345c1b97c9cfd949fe3d2e3296fd9681

p4raw-id: //depot/maint-5.10/perl@34273
p4raw-integrated: from //depot/perl@34271 'copy in' t/comp/script.t
(@14340..) t/run/switcht.t (@18453..) t/io/fflush.t (@19491..)
lib/DirHandle.t (@19580..) t/run/switchF1.t (@23730..)
t/op/lfs.t (@25071..) t/op/mydef.t (@25180..) t/io/crlf.t
(@25625..) t/io/nargv.t (@25973..) t/io/read.t t/io/tell.t
t/op/read.t (@26178..) t/io/through.t (@26857..) t/comp/utf.t
t/io/utf8.t t/run/switchC.t (@29056..) t/run/switchd.t
(@30059..) t/io/inplace.t t/io/iprefix.t (@30543..)
t/op/readline.t (@30750..) t/run/cloexec.t (@31438..)
t/op/goto.t (@31504..) t/io/layers.t (@31648..) t/comp/use.t
(@32003..) t/op/taint.t (@32278..) t/op/closure.t (@32906..)
t/op/fork.t (@33749..) t/op/dbm.t (@33768..) t/op/stat.t
(@34056..) t/op/eval.t (@34069..) t/op/inccode.t (@34092..)
t/op/runlevel.t (@34180..) t/io/dup.t t/io/fs.t (@34182..)
t/run/runenv.t (@34183..) t/comp/multiline.t (@34184..) 'merge
in' t/io/open.t (@34042..)
p4raw-integrated: from //depot/perl@34184 'merge in' t/run/switches.t
(@34040..)

38 files changed:
lib/DirHandle.t
t/comp/multiline.t
t/comp/script.t
t/comp/use.t
t/comp/utf.t
t/io/crlf.t
t/io/dup.t
t/io/fflush.t
t/io/fs.t
t/io/inplace.t
t/io/iprefix.t
t/io/layers.t
t/io/nargv.t
t/io/open.t
t/io/read.t
t/io/tell.t
t/io/through.t
t/io/utf8.t
t/op/closure.t
t/op/dbm.t
t/op/eval.t
t/op/fork.t
t/op/goto.t
t/op/inccode.t
t/op/lfs.t
t/op/mydef.t
t/op/read.t
t/op/readline.t
t/op/runlevel.t
t/op/stat.t
t/op/taint.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 b654f6d..35a7ea8 100755 (executable)
@@ -15,6 +15,15 @@ require './test.pl';
 
 plan(5);
 
+# Fetching the list of files in two different ways and expecting them 
+# to be the same is a race condition when tests are running in parallel.
+# So go somewhere quieter.
+my $chdir;
+if ($ENV{PERL_CORE} && -d 'uni') {
+  chdir 'uni';
+  $chdir++;
+};
+
 $dot = new DirHandle ($^O eq 'MacOS' ? ':' : '.');
 
 ok(defined($dot));
@@ -33,3 +42,7 @@ cmp_ok(+(join("\0", @b), 'eq', join("\0", @c)));
 $dot->close;
 $dot->rewind;
 ok(!defined($dot->read));
+
+if ($chdir) {
+  chdir "..";
+}
index e8b7cf4..1af76fc 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>) {
@@ -41,13 +42,12 @@ is($z, $y,  'basic multiline reading');
 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`;
+$out = (($^O eq 'MSWin32') || $^O eq 'NetWare' || $^O eq 'VMS') ? `type $filename`
+    : ($^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 c3c23e0..4c97a91 100644 (file)
@@ -9,10 +9,7 @@ use Config;
 
 require "test.pl";
 
-my $file = "crlf$$.dat";
-END {
-    1 while unlink($file);
-}
+my $file = tempfile();
 
 if (find PerlIO::Layer 'perlio') {
     plan(tests => 16);
index 3f211b4..ac2f3f4 100755 (executable)
@@ -17,7 +17,9 @@ print "ok 1\n";
 open(DUPOUT,">&STDOUT");
 open(DUPERR,">&STDERR");
 
-open(STDOUT,">Io.dup")  || die "Can't open stdout";
+my $tempfile = tempfile();
+
+open(STDOUT,">$tempfile")  || die "Can't open stdout";
 open(STDERR,">&STDOUT") || die "Can't open stderr";
 
 select(STDERR); $| = 1;
@@ -36,19 +38,12 @@ $cmd = sprintf "$echo 1>&2", 5;
 $cmd = sprintf $echo, 5 if $^O eq 'MacOS';  # don't know if we can do this ...
 print `$cmd`;
 
-# KNOWN BUG system() does not honor STDOUT redirections on VMS.
-if( $^O eq 'VMS' ) {
-    print "not ok $_ # TODO system() not honoring STDOUT redirect on VMS\n"
-      for 6..7;
+system sprintf $echo, 6;
+if ($^O eq 'MacOS') {
+    system sprintf $echo, 7;
 }
 else {
-    system sprintf $echo, 6;
-    if ($^O eq 'MacOS') {
-        system sprintf $echo, 7;
-    }
-    else {
-        system sprintf "$echo 1>&2", 7;
-    }
+    system sprintf "$echo 1>&2", 7;
 }
 
 close(STDOUT) or die "Could not close: $!";
@@ -57,10 +52,10 @@ close(STDERR) or die "Could not close: $!";
 open(STDOUT,">&DUPOUT") or die "Could not open: $!";
 open(STDERR,">&DUPERR") or die "Could not open: $!";
 
-if (($^O eq 'MSWin32') || ($^O eq 'NetWare') || ($^O eq 'VMS')) { print `type Io.dup` }
-elsif ($^O eq 'MacOS') { system 'catenate Io.dup' }
-else                   { system 'cat Io.dup' }
-unlink 'Io.dup';
+if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) { print `type $tempfile` }
+elsif ($^O eq 'VMS')   { system "type $tempfile.;" } # TYPE defaults to .LIS when there is no extension
+elsif ($^O eq 'MacOS') { system "catenate $tempfile" }
+else                   { system "cat $tempfile" }
 
 print STDOUT "ok 8\n";
 
@@ -110,7 +105,7 @@ SKIP: {
     is(fileno(F), fileno(STDERR));
     close F;
 
-    open(G, ">dup$$") or die;
+    open(G, ">$tempfile") or die;
     my $g = fileno(G);
 
     ok(open(F, ">&=$g"));
@@ -126,7 +121,7 @@ SKIP: {
     close G; # flush first
     close F; # flush second
 
-    open(G, "<dup$$") or die;
+    open(G, "<$tempfile") or die;
     {
        my $line;
        $line = <G>; chomp $line; is($line, "ggg");
@@ -134,7 +129,7 @@ SKIP: {
     }
     close G;
 
-    open UTFOUT, '>:utf8', "dup$$" or die $!;
+    open UTFOUT, '>:utf8', $tempfile or die $!;
     open UTFDUP, '>&UTFOUT' or die $!;
     # some old greek saying.
     my $message = "\x{03A0}\x{0391}\x{039D}\x{03A4}\x{0391} \x{03A1}\x{0395}\x{0399}\n";
@@ -144,7 +139,7 @@ SKIP: {
     print UTFDUP $message;
     close UTFOUT;
     close UTFDUP;
-    open(UTFIN, "<:utf8", "dup$$") or die $!;
+    open(UTFIN, "<:utf8", $tempfile) or die $!;
     {
        my $line;
        $line = <UTFIN>; is($line, $message);
@@ -153,5 +148,4 @@ SKIP: {
     }
     close UTFIN;
 
-    END { 1 while unlink "dup$$" }
 }
index 19143c6..056517f 100644 (file)
@@ -37,14 +37,6 @@ if ($useperlio || $fflushNULL || $d_sfio) {
 my $runperl = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
 $runperl .= qq{ "-I../lib"};
 
-my @delete;
-
-END {
-    for (@delete) {
-       unlink $_ or warn "unlink $_: $!";
-    }
-}
-
 sub file_eq {
     my $f   = shift;
     my $val = shift;
@@ -60,7 +52,8 @@ sub file_eq {
 
 # This script will be used as the command to execute from
 # child processes
-open PROG, "> ff-prog" or die "open ff-prog: $!";
+my $ffprog = tempfile();
+open PROG, "> $ffprog" or die "open $ffprog: $!";
 print PROG <<'EOF';
 my $f = shift;
 my $str = shift;
@@ -69,8 +62,7 @@ print OUT $str;
 close OUT;
 EOF
     ;
-close PROG or die "close ff-prog: $!";;
-push @delete, "ff-prog";
+close PROG or die "close $ffprog: $!";;
 
 $| = 0; # we want buffered output
 
@@ -78,7 +70,7 @@ $| = 0; # we want buffered output
 if (!$d_fork) {
     print "ok 1 # skipped: no fork\n";
 } else {
-    my $f = "ff-fork-$$";
+    my $f = tempfile();
     open OUT, "> $f" or die "open $f: $!";
     print OUT "Pe";
     my $pid = fork;
@@ -89,7 +81,7 @@ if (!$d_fork) {
     } elsif (defined $pid) {
        # Kid
        print OUT "r";
-       my $command = qq{$runperl "ff-prog" "$f" "l"};
+       my $command = qq{$runperl "$ffprog" "$f" "l"};
        print "# $command\n";
        exec $command or die $!;
        exit;
@@ -99,7 +91,6 @@ if (!$d_fork) {
     }
 
     print file_eq($f, "Perl") ? "ok 1\n" : "not ok 1\n";
-    push @delete, $f;
 }
 
 # Test flush on system/qx/pipe open
@@ -121,15 +112,14 @@ my %subs = (
 my $t = 2;
 for (qw(system qx popen)) {
     my $code    = $subs{$_};
-    my $f       = "ff-$_-$$";
-    my $command = qq{$runperl "ff-prog" "$f" "rl"};
+    my $f       = tempfile();
+    my $command = qq{$runperl $ffprog "$f" "rl"};
     open OUT, "> $f" or die "open $f: $!";
     print OUT "Pe";
     close OUT or die "close $f: $!";;
     print "# $command\n";
     $code->($command);
     print file_eq($f, "Perl") ? "ok $t\n" : "not ok $t\n";
-    push @delete, $f;
     ++$t;
 }
 
index 5113a5f..cd8bd55 100755 (executable)
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -51,25 +51,27 @@ my $skip_mode_checks =
 
 plan tests => 51;
 
+my $tmpdir = tempfile();
+my $tmpdir1 = tempfile();
 
 if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) {
-    `rmdir /s /q tmp 2>nul`;
-    `mkdir tmp`;
+    `rmdir /s /q $tmpdir 2>nul`;
+    `mkdir $tmpdir`;
 }
 elsif ($^O eq 'VMS') {
-    `if f\$search("[.tmp]*.*") .nes. "" then delete/nolog/noconfirm [.tmp]*.*.*`;
-    `if f\$search("tmp.dir") .nes. "" then set file/prot=o:rwed tmp.dir;`;
-    `if f\$search("tmp.dir") .nes. "" then delete/nolog/noconfirm tmp.dir;`;
-    `create/directory [.tmp]`;
+    `if f\$search("[.$tmpdir]*.*") .nes. "" then delete/nolog/noconfirm [.$tmpdir]*.*.*`;
+    `if f\$search("$tmpdir.dir") .nes. "" then set file/prot=o:rwed $tmpdir.dir;`;
+    `if f\$search("$tmpdir.dir") .nes. "" then delete/nolog/noconfirm $tmpdir.dir;`;
+    `create/directory [.$tmpdir]`;
 }
 elsif ($Is_MacOS) {
-    rmdir "tmp"; mkdir "tmp";
+    rmdir "$tmpdir"; mkdir "$tmpdir";
 }
 else {
-    `rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`;
+    `rm -f $tmpdir 2>/dev/null; mkdir $tmpdir 2>/dev/null`;
 }
 
-chdir catdir(curdir(), 'tmp');
+chdir catdir(curdir(), $tmpdir);
 
 `/bin/rm -rf a b c x` if -x '/bin/rm';
 
@@ -330,8 +332,8 @@ SKIP: {
     unlink("TEST$$");
 }
 
-unlink "Iofs.tmp";
-open IOFSCOM, ">Iofs.tmp" or die "Could not write IOfs.tmp: $!";
+my $tmpfile = tempfile();
+open IOFSCOM, ">$tmpfile" or die "Could not write IOfs.tmp: $!";
 print IOFSCOM 'helloworld';
 close(IOFSCOM);
 
@@ -340,24 +342,24 @@ close(IOFSCOM);
 
 SKIP: {
 # Check truncating a closed file.
-    eval { truncate "Iofs.tmp", 5; };
+    eval { truncate $tmpfile, 5; };
 
     skip("no truncate - $@", 8) if $@;
 
-    is(-s "Iofs.tmp", 5, "truncation to five bytes");
+    is(-s $tmpfile, 5, "truncation to five bytes");
 
-    truncate "Iofs.tmp", 0;
+    truncate $tmpfile, 0;
 
-    ok(-z "Iofs.tmp",    "truncation to zero bytes");
+    ok(-z $tmpfile,    "truncation to zero bytes");
 
 #these steps are necessary to check if file is really truncated
 #On Win95, FH is updated, but file properties aren't
-    open(FH, ">Iofs.tmp") or die "Can't create Iofs.tmp";
+    open(FH, ">$tmpfile") or die "Can't create $tmpfile";
     print FH "x\n" x 200;
     close FH;
 
 # Check truncating an open file.
-    open(FH, ">>Iofs.tmp") or die "Can't open Iofs.tmp for appending";
+    open(FH, ">>$tmpfile") or die "Can't open $tmpfile for appending";
 
     binmode FH;
     select FH;
@@ -371,7 +373,7 @@ SKIP: {
     }
 
     if ($needs_fh_reopen) {
-       close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+       close (FH); open (FH, ">>$tmpfile") or die "Can't reopen $tmpfile";
     }
 
     SKIP: {
@@ -379,19 +381,19 @@ SKIP: {
            skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below the current file pos.", 5);
        }
 
-       is(-s "Iofs.tmp", 200, "fh resize to 200 working (filename check)");
+       is(-s $tmpfile, 200, "fh resize to 200 working (filename check)");
 
        ok(truncate(FH, 0), "fh resize to zero");
 
        if ($needs_fh_reopen) {
-           close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+           close (FH); open (FH, ">>$tmpfile") or die "Can't reopen $tmpfile";
        }
 
-       ok(-z "Iofs.tmp", "fh resize to zero working (filename check)");
+       ok(-z $tmpfile, "fh resize to zero working (filename check)");
 
        close FH;
 
-       open(FH, ">>Iofs.tmp") or die "Can't open Iofs.tmp for appending";
+       open(FH, ">>$tmpfile") or die "Can't open $tmpfile for appending";
 
        binmode FH;
        select FH;
@@ -405,10 +407,10 @@ SKIP: {
        }
 
        if ($needs_fh_reopen) {
-           close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+           close (FH); open (FH, ">>$tmpfile") or die "Can't reopen $tmpfile";
        }
 
-       is(-s "Iofs.tmp", 100, "fh resize by IO slot working");
+       is(-s $tmpfile, 100, "fh resize by IO slot working");
 
        close FH;
     }
@@ -419,7 +421,7 @@ SKIP: {
     skip "Works in Cygwin only if check_case is set to relaxed", 1
       if ($ENV{'CYGWIN'} && ($ENV{'CYGWIN'} =~ /check_case:(?:adjust|strict)/));
 
-    chdir './tmp';
+    chdir "./$tmpdir";
     open(FH,'>x') || die "Can't create x";
     close(FH);
     rename('x', 'X');
@@ -434,15 +436,15 @@ SKIP: {
 # check if rename() works on directories
 if ($^O eq 'VMS') {
     # must have delete access to rename a directory
-    `set file tmp.dir/protection=o:d`;
-    ok(rename('tmp.dir', 'tmp1.dir'), "rename on directories") ||
+    `set file $tmpdir.dir/protection=o:d`;
+    ok(rename("$tmpdir.dir", "$tmpdir1.dir"), "rename on directories") ||
       print "# errno: $!\n";
 }
 else {
-    ok(rename('tmp', 'tmp1'), "rename on directories");
+    ok(rename($tmpdir, $tmpdir1), "rename on directories");
 }
 
-ok(-d 'tmp1', "rename on directories working");
+ok(-d $tmpdir1, "rename on directories working");
 
 {
     # Change 26011: Re: A surprising segfault
@@ -455,5 +457,5 @@ ok(-d 'tmp1', "rename on directories working");
     ok(1, "extend sp in pp_chown");
 }
 
-# need to remove 'tmp' if rename() in test 28 failed!
-END { rmdir 'tmp1'; rmdir 'tmp'; 1 while unlink "Iofs.tmp"; }
+# need to remove $tmpdir if rename() in test 28 failed!
+END { rmdir $tmpdir1; rmdir $tmpdir; }
index a7a21e4..a9664dc 100755 (executable)
@@ -6,10 +6,10 @@ $^I = $^O eq 'VMS' ? '_bak' : '.bak';
 
 plan( tests => 2 );
 
-my @tfiles     = ('.a','.b','.c');
-my @tfiles_bak = (".a$^I", ".b$^I", ".c$^I");
+my @tfiles     = (tempfile(), tempfile(), tempfile());
+my @tfiles_bak = map "$_$^I", @tfiles;
 
-END { unlink_all('.a','.b','.c',".a$^I", ".b$^I", ".c$^I"); }
+END { unlink_all(@tfiles_bak); }
 
 for my $file (@tfiles) {
     runperl( prog => 'print qq(foo\n);', 
index 25dd69d..9e09ce0 100755 (executable)
@@ -2,16 +2,16 @@
 use strict;
 require './test.pl';
 
-$^I = 'bak*';
+$^I = 'bak.*';
 
 # Modified from the original inplace.t to test adding prefixes
 
 plan( tests => 2 );
 
-my @tfiles     = ('.a','.b','.c');
-my @tfiles_bak = ('bak.a', 'bak.b', 'bak.c');
+my @tfiles     = (tempfile(), tempfile(), tempfile());
+my @tfiles_bak = map "bak.$_", @tfiles;
 
-END { unlink_all('.a','.b','.c', 'bak.a', 'bak.b', 'bak.c'); }
+END { unlink_all(@tfiles_bak); }
 
 for my $file (@tfiles) {
     runperl( prog => 'print qq(foo\n);', 
index abbc7ec..cddd436 100644 (file)
@@ -125,7 +125,8 @@ SKIP: {
          $UTF8_STDIN ? [ "stdio", "utf8" ] : [ "stdio" ],
          "STDIN");
 
-    open(F, ">:crlf", "afile");
+    my $afile = tempfile();
+    open(F, ">:crlf", $afile);
 
     check([ PerlIO::get_layers(F) ],
          [ qw(stdio crlf) ],
@@ -199,8 +200,8 @@ SKIP: {
     {
        use open(IN => ":crlf", OUT => ":encoding(cp1252)");
 
-       open F, "<afile";
-       open G, ">afile";
+       open F, '<', $afile;
+       open G, '>', $afile;
 
        check([ PerlIO::get_layers(F, input  => 1) ],
              [ qw(stdio crlf) ],
@@ -216,10 +217,8 @@ SKIP: {
 
     # Check that PL_sigwarn's reference count is correct, and that 
     # &PerlIO::Layer::NoWarnings isn't prematurely freed.
-    fresh_perl_like (<<'EOT', qr/^CODE/);
-open(UTF, "<:raw:encoding(utf8)", "afile") or die $!;
+    fresh_perl_like (<<"EOT", qr/^CODE/);
+open(UTF, "<:raw:encoding(utf8)", '$afile') or die \$!;
 print ref *PerlIO::Layer::NoWarnings{CODE};
 EOT
-
-    1 while unlink "afile";
 }
index 97ab639..c5b84fc 100755 (executable)
@@ -1,5 +1,11 @@
 #!./perl
 
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require "./test.pl";
+}
+
 print "1..5\n";
 
 my $j = 1;
@@ -56,9 +62,13 @@ sub other {
     }
 }
 
+my @files;
 sub mkfiles {
-    my @files = map { "scratch$_" } @_;
-    return wantarray ? @files : $files[-1];
+    foreach (@_) {
+       $files[$_] ||= tempfile();
+    }
+    my @results = @files[@_];
+    return wantarray ? @results : @results[-1];
 }
 
 END { unlink map { ($_, "$_.bak") } mkfiles(1..5) }
index f08eed5..c423089 100755 (executable)
@@ -16,14 +16,15 @@ plan tests => 108;
 
 my $Perl = which_perl();
 
+my $afile = tempfile();
 {
-    unlink("afile") if -f "afile";
+    unlink($afile) if -f $afile;
 
-    $! = 0;  # the -f above will set $! if 'afile' doesn't exist.
-    ok( open(my $f,"+>afile"),  'open(my $f, "+>...")' );
+    $! = 0;  # the -f above will set $! if $afile doesn't exist.
+    ok( open(my $f,"+>$afile"),  'open(my $f, "+>...")' );
 
     binmode $f;
-    ok( -f "afile",             '       its a file');
+    ok( -f $afile,              '       its a file');
     ok( (print $f "SomeData\n"),  '       we can print to it');
     is( tell($f), 9,            '       tell()' );
     ok( seek($f,0,0),           '       seek set' );
@@ -36,25 +37,25 @@ my $Perl = which_perl();
     like( $@, qr/<\$f> line 1/, '       die message correct' );
     
     ok( close($f),              '       close()' );
-    ok( unlink("afile"),        '       unlink()' );
+    ok( unlink($afile),         '       unlink()' );
 }
 
 {
-    ok( open(my $f,'>', 'afile'),       "open(my \$f, '>', 'afile')" );
+    ok( open(my $f,'>', $afile),        "open(my \$f, '>', $afile)" );
     ok( (print $f "a row\n"),           '       print');
     ok( close($f),                      '       close' );
-    ok( -s 'afile' < 10,                '       -s' );
+    ok( -s $afile < 10,                 '       -s' );
 }
 
 {
-    ok( open(my $f,'>>', 'afile'),      "open(my \$f, '>>', 'afile')" );
+    ok( open(my $f,'>>', $afile),       "open(my \$f, '>>', $afile)" );
     ok( (print $f "a row\n"),           '       print' );
     ok( close($f),                      '       close' );
-    ok( -s 'afile' > 10,                '       -s'    );
+    ok( -s $afile > 10,                 '       -s'    );
 }
 
 {
-    ok( open(my $f, '<', 'afile'),      "open(my \$f, '<', 'afile')" );
+    ok( open(my $f, '<', $afile),       "open(my \$f, '<', $afile)" );
     my @rows = <$f>;
     is( scalar @rows, 2,                '       readline, list context' );
     is( $rows[0], "a row\n",            '       first line read' );
@@ -63,17 +64,17 @@ my $Perl = which_perl();
 }
 
 {
-    ok( -s 'afile' < 20,                '-s' );
+    ok( -s $afile < 20,                 '-s' );
 
-    ok( open(my $f, '+<', 'afile'),     'open +<' );
+    ok( open(my $f, '+<', $afile),      'open +<' );
     my @rows = <$f>;
     is( scalar @rows, 2,                '       readline, list context' );
     ok( seek($f, 0, 1),                 '       seek cur' );
     ok( (print $f "yet another row\n"), '       print' );
     ok( close($f),                      '       close' );
-    ok( -s 'afile' > 20,                '       -s' );
+    ok( -s $afile > 20,                 '       -s' );
 
-    unlink("afile");
+    unlink($afile);
 }
 
 SKIP: {
@@ -109,18 +110,18 @@ EOC
 }
 
 
-ok( !eval { open my $f, '<&', 'afile'; 1; },    '<& on a non-filehandle' );
-like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
+ok( !eval { open my $f, '<&', $afile; 1; },    '<& on a non-filehandle' );
+like( $@, qr/Bad filehandle:\s+$afile/,          '       right error' );
 
 
 # local $file tests
 {
-    unlink("afile") if -f "afile";
+    unlink($afile) if -f $afile;
 
-    ok( open(local $f,"+>afile"),       'open local $f, "+>", ...' );
+    ok( open(local $f,"+>$afile"),       'open local $f, "+>", ...' );
     binmode $f;
 
-    ok( -f "afile",                     '       -f' );
+    ok( -f $afile,                      '       -f' );
     ok( (print $f "SomeData\n"),        '       print' );
     is( tell($f), 9,                    '       tell' );
     ok( seek($f,0,0),                   '       seek set' );
@@ -133,42 +134,42 @@ like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
     like( $@, qr/<\$f> line 1/,         '       proper die message' );
     ok( close($f),                      '       close' );
 
-    unlink("afile");
+    unlink($afile);
 }
 
 {
-    ok( open(local $f,'>', 'afile'),    'open local $f, ">", ...' );
+    ok( open(local $f,'>', $afile),     'open local $f, ">", ...' );
     ok( (print $f "a row\n"),           '       print');
     ok( close($f),                      '       close');
-    ok( -s 'afile' < 10,                '       -s' );
+    ok( -s $afile < 10,                 '       -s' );
 }
 
 {
-    ok( open(local $f,'>>', 'afile'),   'open local $f, ">>", ...' );
+    ok( open(local $f,'>>', $afile),    'open local $f, ">>", ...' );
     ok( (print $f "a row\n"),           '       print');
     ok( close($f),                      '       close');
-    ok( -s 'afile' > 10,                '       -s' );
+    ok( -s $afile > 10,                 '       -s' );
 }
 
 {
-    ok( open(local $f, '<', 'afile'),   'open local $f, "<", ...' );
+    ok( open(local $f, '<', $afile),    'open local $f, "<", ...' );
     my @rows = <$f>;
     is( scalar @rows, 2,                '       readline list context' );
     ok( close($f),                      '       close' );
 }
 
-ok( -s 'afile' < 20,                '       -s' );
+ok( -s $afile < 20,                     '       -s' );
 
 {
-    ok( open(local $f, '+<', 'afile'),  'open local $f, "+<", ...' );
+    ok( open(local $f, '+<', $afile),  'open local $f, "+<", ...' );
     my @rows = <$f>;
     is( scalar @rows, 2,                '       readline list context' );
     ok( seek($f, 0, 1),                 '       seek cur' );
     ok( (print $f "yet another row\n"), '       print' );
     ok( close($f),                      '       close' );
-    ok( -s 'afile' > 20,                '       -s' );
+    ok( -s $afile > 20,                 '       -s' );
 
-    unlink("afile");
+    unlink($afile);
 }
 
 SKIP: {
@@ -204,8 +205,8 @@ EOC
 }
 
 
-ok( !eval { open local $f, '<&', 'afile'; 1 },  'local <& on non-filehandle');
-like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
+ok( !eval { open local $f, '<&', $afile; 1 },  'local <& on non-filehandle');
+like( $@, qr/Bad filehandle:\s+$afile/,          '       right error' );
 
 {
     local *F;
@@ -289,19 +290,19 @@ SKIP: {
     use warnings 'layer';
     local $SIG{__WARN__} = sub { $w = shift };
 
-    eval { open(F, ">>>", "afile") };
+    eval { open(F, ">>>", $afile) };
     like($w, qr/Invalid separator character '>' in PerlIO layer spec/,
         "bad open (>>>) warning");
     like($@, qr/Unknown open\(\) mode '>>>'/,
         "bad open (>>>) failure");
 
-    eval { open(F, ">:u", "afile" ) };
+    eval { open(F, ">:u", $afile ) };
     like($w, qr/Unknown PerlIO layer "u"/,
         'bad layer ">:u" warning');
-    eval { open(F, "<:u", "afile" ) };
+    eval { open(F, "<:u", $afile ) };
     like($w, qr/Unknown PerlIO layer "u"/,
         'bad layer "<:u" warning');
-    eval { open(F, ":c", "afile" ) };
+    eval { open(F, ":c", $afile ) };
     like($@, qr/Unknown open\(\) mode ':c'/,
         'bad layer ":c" failure');
 }
index 2665ecb..57e671d 100755 (executable)
@@ -12,7 +12,9 @@ die $@ if $@ and !$ENV{PERL_CORE_MINITEST};
 
 plan tests => 2;
 
-open(A,"+>a");
+my $tmpfile = tempfile();
+
+open(A,"+>$tmpfile");
 print A "_";
 seek(A,0,0);
 
@@ -23,12 +25,8 @@ read(A,$b,1,4);
 
 close(A);
 
-unlink("a");
-
 is($b,"\000\000\000\000_"); # otherwise probably "\000bcd_"
 
-unlink 'a';
-
 SKIP: {
     skip "no EBADF", 1 if (!exists &Errno::EBADF);
 
index 4881d43..09b61a3 100755 (executable)
@@ -3,6 +3,7 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
 print "1..28\n";
@@ -101,9 +102,7 @@ close(OTHER);
 # something else.  ftell() on pipes, fifos, and sockets is defined to
 # return -1.
 
-my $written = "tell_write.txt";
-
-END { 1 while unlink($written) }
+my $written = tempfile();
 
 close($TST);
 open($tst,">$written")  || die "Cannot open $written:$!";
index 60c75c9..a76c64d 100644 (file)
@@ -90,7 +90,8 @@ sub testfile ($$$$$$) {
   my ($str, $write_c, $read_c, $how_w, $how_r, $why) = @_;
   my @data = grep length, split /(.{1,$write_c})/s, $str;
 
-  open my $fh, '>', 'io_io.tmp' or die;
+  my $filename = tempfile();
+  open my $fh, '>', $filename or die;
   select $fh;
   binmode $fh, ':crlf' 
       if defined $main::use_crlf && $main::use_crlf == 1;
@@ -106,7 +107,7 @@ sub testfile ($$$$$$) {
     die "Unrecognized write: '$how_w'";
   }
   close $fh or die "close: $!";
-  open $fh, '<', 'io_io.tmp' or die;
+  open $fh, '<', $filename or die;
   binmode $fh, ':crlf'
       if defined $main::use_crlf && $main::use_crlf == 1;
   testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "file$why");
@@ -143,6 +144,4 @@ for my $s (1..2) {
   }
 }
 
-unlink 'io_io.tmp';
-
 1;
index 2117338..07f829b 100755 (executable)
@@ -17,7 +17,9 @@ plan(tests => 55);
 
 $| = 1;
 
-open(F,"+>:utf8",'a');
+my $a_file = tempfile();
+
+open(F,"+>:utf8",$a_file);
 print F chr(0x100).'�';
 cmp_ok( tell(F), '==', 4, tell(F) );
 print F "\n";
@@ -29,16 +31,16 @@ is( getc(F), "\n" );
 seek(F,0,0);
 binmode(F,":bytes");
 my $chr = chr(0xc4);
-if (ord('A') == 193) { $chr = chr(0x8c); } # EBCDIC
+if (ord($a_file) == 193) { $chr = chr(0x8c); } # EBCDIC
 is( getc(F), $chr );
 $chr = chr(0x80);
-if (ord('A') == 193) { $chr = chr(0x41); } # EBCDIC
+if (ord($a_file) == 193) { $chr = chr(0x41); } # EBCDIC
 is( getc(F), $chr );
 $chr = chr(0xc2);
-if (ord('A') == 193) { $chr = chr(0x80); } # EBCDIC
+if (ord($a_file) == 193) { $chr = chr(0x80); } # EBCDIC
 is( getc(F), $chr );
 $chr = chr(0xa3);
-if (ord('A') == 193) { $chr = chr(0x44); } # EBCDIC
+if (ord($a_file) == 193) { $chr = chr(0x44); } # EBCDIC
 is( getc(F), $chr );
 is( getc(F), "\n" );
 seek(F,0,0);
@@ -55,25 +57,25 @@ close(F);
     $a = chr(300); # This *is* UTF-encoded
     $b = chr(130); # This is not.
 
-    open F, ">:utf8", 'a' or die $!;
+    open F, ">:utf8", $a_file or die $!;
     print F $a,"\n";
     close F;
 
-    open F, "<:utf8", 'a' or die $!;
+    open F, "<:utf8", $a_file or die $!;
     $x = <F>;
     chomp($x);
     is( $x, chr(300) );
 
-    open F, "a" or die $!; # Not UTF
+    open F, $a_file or die $!; # Not UTF
     binmode(F, ":bytes");
     $x = <F>;
     chomp($x);
     $chr = chr(196).chr(172);
-    if (ord('A') == 193) { $chr = chr(141).chr(83); } # EBCDIC
+    if (ord($a_file) == 193) { $chr = chr(141).chr(83); } # EBCDIC
     is( $x, $chr );
     close F;
 
-    open F, ">:utf8", 'a' or die $!;
+    open F, ">:utf8", $a_file or die $!;
     binmode(F);  # we write a "\n" and then tell() - avoid CRLF issues.
     binmode(F,":utf8"); # turn UTF-8-ness back on
     print F $a;
@@ -103,7 +105,7 @@ close(F);
 
     close F;
 
-    open F, "a" or die $!; # Not UTF
+    open F, $a_file or die $!; # Not UTF
     binmode(F, ":bytes");
     $x = <F>;
     chomp($x);
@@ -111,13 +113,13 @@ close(F);
     if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC
     is( $x, $chr, sprintf('(%vd)', $x) );
 
-    open F, "<:utf8", "a" or die $!;
+    open F, "<:utf8", $a_file or die $!;
     $x = <F>;
     chomp($x);
     close F;
     is( $x, chr(300).chr(130), sprintf('(%vd)', $x) );
 
-    open F, ">", "a" or die $!;
+    open F, ">", $a_file or die $!;
     binmode(F, ":bytes:");
 
     # Now let's make it suffer.
@@ -132,13 +134,13 @@ close(F);
 }
 
 # Hm. Time to get more evil.
-open F, ">:utf8", "a" or die $!;
+open F, ">:utf8", $a_file or die $!;
 print F $a;
 binmode(F, ":bytes");
 print F chr(130)."\n";
 close F;
 
-open F, "<", "a" or die $!;
+open F, "<", $a_file or die $!;
 binmode(F, ":bytes");
 $x = <F>; chomp $x;
 $chr = v196.172.130;
@@ -146,15 +148,15 @@ if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC
 is( $x, $chr );
 
 # Right.
-open F, ">:utf8", "a" or die $!;
+open F, ">:utf8", $a_file or die $!;
 print F $a;
 close F;
-open F, ">>", "a" or die $!;
+open F, ">>", $a_file or die $!;
 binmode(F, ":bytes");
 print F chr(130)."\n";
 close F;
 
-open F, "<", "a" or die $!;
+open F, "<", $a_file or die $!;
 binmode(F, ":bytes");
 $x = <F>; chomp $x;
 SKIP: {
@@ -170,7 +172,7 @@ SKIP: {
        skip("EBCDIC doesn't complain", 2);
     } else {
        my @warnings;
-       open F, "<:utf8", "a" or die $!;
+       open F, "<:utf8", $a_file or die $!;
        $x = <F>; chomp $x;
        local $SIG{__WARN__} = sub { push @warnings, $_[0]; };
        eval { sprintf "%vd\n", $x };
@@ -180,9 +182,9 @@ SKIP: {
 }
 
 close F;
-unlink('a');
+unlink($a_file);
 
-open F, ">:utf8", "a";
+open F, ">:utf8", $a_file;
 @a = map { chr(1 << ($_ << 2)) } 0..5; # 0x1, 0x10, .., 0x100000
 unshift @a, chr(0); # ... and a null byte in front just for fun
 print F @a;
@@ -191,7 +193,7 @@ close F;
 my $c;
 
 # read() should work on characters, not bytes
-open F, "<:utf8", "a";
+open F, "<:utf8", $a_file;
 $a = 0;
 my $failed;
 for (@a) {
@@ -219,7 +221,7 @@ is($failed, undef);
     local $SIG{__WARN__} = sub { $@ = shift };
 
     undef $@;
-    open F, ">a";
+    open F, ">$a_file";
     binmode(F, ":bytes");
     print F chr(0x100);
     close(F);
@@ -227,14 +229,14 @@ is($failed, undef);
     like( $@, 'Wide character in print' );
 
     undef $@;
-    open F, ">:utf8", "a";
+    open F, ">:utf8", $a_file;
     print F chr(0x100);
     close(F);
 
     isnt( defined $@, !0 );
 
     undef $@;
-    open F, ">a";
+    open F, ">$a_file";
     binmode(F, ":utf8");
     print F chr(0x100);
     close(F);
@@ -244,7 +246,7 @@ is($failed, undef);
     no warnings 'utf8';
 
     undef $@;
-    open F, ">a";
+    open F, ">$a_file";
     print F chr(0x100);
     close(F);
 
@@ -253,7 +255,7 @@ is($failed, undef);
     use warnings 'utf8';
 
     undef $@;
-    open F, ">a";
+    open F, ">$a_file";
     binmode(F, ":bytes");
     print F chr(0x100);
     close(F);
@@ -262,9 +264,9 @@ is($failed, undef);
 }
 
 {
-    open F, ">:bytes","a"; print F "\xde"; close F;
+    open F, ">:bytes",$a_file; print F "\xde"; close F;
 
-    open F, "<:bytes", "a";
+    open F, "<:bytes", $a_file;
     my $b = chr 0x100;
     $b .= <F>;
     is( $b, chr(0x100).chr(0xde), "21395 '.= <>' utf8 vs. bytes" );
@@ -272,9 +274,9 @@ is($failed, undef);
 }
 
 {
-    open F, ">:utf8","a"; print F chr 0x100; close F;
+    open F, ">:utf8",$a_file; print F chr 0x100; close F;
 
-    open F, "<:utf8", "a";
+    open F, "<:utf8", $a_file;
     my $b = "\xde";
     $b .= <F>;
     is( $b, chr(0xde).chr(0x100), "21395 '.= <>' bytes vs. utf8" );
@@ -290,12 +292,12 @@ is($failed, undef);
     for my $u (@a) {
        for my $v (@a) {
            # print "# @$u - @$v\n";
-           open F, ">a";
+           open F, ">$a_file";
            binmode(F, ":" . $u->[1]);
            print F chr($u->[0]);
            close F;
 
-           open F, "<a";
+           open F, "<$a_file";
            binmode(F, ":" . $u->[1]);
 
            my $s = chr($v->[0]);
@@ -312,7 +314,7 @@ is($failed, undef);
 
 {
     # [perl #23428] Somethings rotten in unicode semantics
-    open F, ">a";
+    open F, ">$a_file";
     binmode F, ":utf8";
     syswrite(F, $a = chr(0x100));
     close F;
@@ -328,7 +330,7 @@ is($failed, undef);
     use warnings 'utf8';
     undef $@;
     local $SIG{__WARN__} = sub { $@ = shift };
-    open F, ">a";
+    open F, ">$a_file";
     binmode F;
     my ($chrE4, $chrF6) = (chr(0xE4), chr(0xF6));
     if (ord('A') == 193)       # EBCDIC
@@ -336,7 +338,7 @@ is($failed, undef);
     print F "foo", $chrE4, "\n";
     print F "foo", $chrF6, "\n";
     close F;
-    open F, "<:utf8", "a";
+    open F, "<:utf8", $a_file;
     undef $@;
     my $line = <F>;
     my ($chrE4, $chrF6) = ("E4", "F6");
@@ -349,8 +351,3 @@ is($failed, undef);
          "<:utf8 rcatline must warn about bad utf8");
     close F;
 }
-
-END {
-    1 while unlink "a";
-    1 while unlink "b";
-}
index d1cab95..5e3bf45 100755 (executable)
@@ -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;
index e6545fa..2403370 100644 (file)
@@ -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
 
index d3241e6..23725d5 100755 (executable)
@@ -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 \$@";
index a19b260..9fe8107 100755 (executable)
@@ -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;
index 9254d7c..c79b424 100755 (executable)
@@ -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;
index 45022ff..60c3581 100644 (file)
@@ -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') {
index 8f022b8..2de965f 100644 (file)
@@ -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
index f250ff6..444bf4a 100644 (file)
@@ -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";
index 8235bc2..23f1b51 100755 (executable)
@@ -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;
index 0d6598f..1069a97 100644 (file)
@@ -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)
index 36c63ef..44aedc0 100755 (executable)
@@ -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/-/ig;
     $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
     $expected =~ s/\n+$//;
     if ($results ne $expected) {
index d238855..a225de4 100755 (executable)
@@ -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;
index b2688cf..f578423 100755 (executable)
@@ -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';
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 5c3eecb..98845fc 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;