Convert all unimaginative (ie race condition) temporary file names to
Nicholas Clark [Thu, 7 Aug 2008 15:21:57 +0000 (15:21 +0000)]
use test.pl's tempfile().

p4raw-id: //depot/perl@34182

13 files changed:
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

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..18277d9 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;
@@ -57,10 +59,9 @@ 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') || ($^O eq 'VMS')) { print `type $tempfile` }
+elsif ($^O eq 'MacOS') { system "catenate $tempfile" }
+else                   { system "cat $tempfile" }
 
 print STDOUT "ok 8\n";
 
@@ -110,7 +111,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 +127,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 +135,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 +145,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 +154,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..095239b 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 68b828a..325d637 100755 (executable)
@@ -15,14 +15,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' );
@@ -35,25 +36,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' );
@@ -62,17 +63,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);
 }
 {
     ok( open(my $f, '-|', <<EOC),     'open -|' );
@@ -104,18 +105,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' );
@@ -128,42 +129,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);
 }
 
 {
@@ -197,8 +198,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;
@@ -282,19 +283,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";
-}