sub test {
my ($enc, $write, $expect, $bom, $nl, $name) = @_;
- open my $fh, ">", "utf$$.pl" or die "utf.pl: $!";
+ open my $fh, ">", "tmputf$$.pl" or die "tmputf$$.pl: $!";
binmode $fh;
print $fh bytes_to_utf($enc, $write . ($nl ? "\n" : ''), $bom);
close $fh or die $!;
- my $got = do "./utf$$.pl";
+ my $got = do "./tmputf$$.pl";
$test = $test + 1;
if (!defined $got) {
if ($@ =~ /^(Unsupported script encoding \Q$enc\E)/) {
}
END {
- 1 while unlink "utf$$.pl";
+ 1 while unlink "tmputf$$.pl";
}
$devnull = File::Spec->devnull;
}
-open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!");
+open(TRY, '>tmpIo_argv1.tmp') || (die "Can't open temp file: $!");
print TRY "a line\n";
close TRY or die "Could not close: $!";
-open(TRY, '>Io_argv2.tmp') || (die "Can't open temp file: $!");
+open(TRY, '>tmpIo_argv2.tmp') || (die "Can't open temp file: $!");
print TRY "another line\n";
close TRY or die "Could not close: $!";
$x = runperl(
prog => 'while (<>) { print $., $_; }',
- args => [ 'Io_argv1.tmp', 'Io_argv1.tmp' ],
+ args => [ 'tmpIo_argv1.tmp', 'tmpIo_argv1.tmp' ],
);
is($x, "1a line\n2a line\n", '<> from two files');
$x = runperl(
prog => 'while (<>) { print $_; }',
stdin => "foo\n",
- args => [ 'Io_argv1.tmp', '-' ],
+ args => [ 'tmpIo_argv1.tmp', '-' ],
);
is($x, "a line\nfoo\n", '<> from a file and STDIN');
$x = runperl(
prog => 'while (<>) { print $ARGV.q/,/.$_ }',
- args => [ 'Io_argv1.tmp', 'Io_argv2.tmp' ],
+ args => [ 'tmpIo_argv1.tmp', 'tmpIo_argv2.tmp' ],
);
- is($x, "Io_argv1.tmp,a line\nIo_argv2.tmp,another line\n", '$ARGV is the file name');
+ is($x, "tmpIo_argv1.tmp,a line\ntmpIo_argv2.tmp,another line\n", '$ARGV is the file name');
TODO: {
local $::TODO = "unrelated bug in redirection implementation" if $^O eq 'VMS';
is( 0+$?, 0, q(eof() doesn't segfault) );
}
-@ARGV = is_miniperl() ? ('Io_argv1.tmp', 'Io_argv1.tmp', 'Io_argv1.tmp')
- : ('Io_argv1.tmp', 'Io_argv1.tmp', $devnull, 'Io_argv1.tmp');
+@ARGV = is_miniperl() ? ('tmpIo_argv1.tmp', 'tmpIo_argv1.tmp', 'tmpIo_argv1.tmp')
+ : ('tmpIo_argv1.tmp', 'tmpIo_argv1.tmp', $devnull, 'tmpIo_argv1.tmp');
while (<>) {
$y .= $. . $_;
if (eof()) {
is($y, "1a line\n2a line\n3a line\n", '<> from @ARGV');
-open(TRY, '>Io_argv1.tmp') or die "Can't open temp file: $!";
+open(TRY, '>tmpIo_argv1.tmp') or die "Can't open temp file: $!";
close TRY or die "Could not close: $!";
-open(TRY, '>Io_argv2.tmp') or die "Can't open temp file: $!";
+open(TRY, '>tmpIo_argv2.tmp') or die "Can't open temp file: $!";
close TRY or die "Could not close: $!";
-@ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp');
+@ARGV = ('tmpIo_argv1.tmp', 'tmpIo_argv2.tmp');
$^I = '_bak'; # not .bak which confuses VMS
$/ = undef;
my $i = 11;
print;
next_test();
}
-open(TRY, '<Io_argv1.tmp') or die "Can't open temp file: $!";
+open(TRY, '<tmpIo_argv1.tmp') or die "Can't open temp file: $!";
print while <TRY>;
-open(TRY, '<Io_argv2.tmp') or die "Can't open temp file: $!";
+open(TRY, '<tmpIo_argv2.tmp') or die "Can't open temp file: $!";
print while <TRY>;
close TRY or die "Could not close: $!";
undef $^I;
ok( eof NEVEROPENED, 'eof() true on unopened filehandle' );
}
-open STDIN, 'Io_argv1.tmp' or die $!;
+open STDIN, 'tmpIo_argv1.tmp' or die $!;
@ARGV = ();
ok( !eof(), 'STDIN has something' );
@ARGV = ();
ok( eof(), 'eof() true with empty @ARGV' );
- @ARGV = ('Io_argv1.tmp');
+ @ARGV = ('tmpIo_argv1.tmp');
ok( !eof() );
@ARGV = ($devnull, $devnull);
SKIP: {
local $/;
- open my $fh, 'Io_argv1.tmp' or die "Could not open Io_argv1.tmp: $!";
+ open my $fh, 'tmpIo_argv1.tmp' or die "Could not open tmpIo_argv1.tmp: $!";
<$fh>; # set $. = 1
is( <$fh>, undef );
close $fh or die "Could not close: $!";
}
-open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!");
+open(TRY, '>tmpIo_argv1.tmp') || (die "Can't open temp file: $!");
print TRY "one\n\nthree\n";
close TRY or die "Could not close: $!";
$x = runperl(
prog => 'print $..$ARGV.$_ while <<>>',
- args => [ 'Io_argv1.tmp' ],
+ args => [ 'tmpIo_argv1.tmp' ],
);
-is($x, "1Io_argv1.tmpone\n2Io_argv1.tmp\n3Io_argv1.tmpthree\n", '<<>>');
+is($x, "1tmpIo_argv1.tmpone\n2tmpIo_argv1.tmp\n3tmpIo_argv1.tmpthree\n", '<<>>');
$x = runperl(
prog => '$w=q/b/;$w.=<<>>;print $w',
- args => [ 'Io_argv1.tmp' ],
+ args => [ 'tmpIo_argv1.tmp' ],
);
is($x, "bone\n", '<<>> and rcatline');
$x = runperl(
prog => 'while (<<>>) { }',
stderr => 1,
- args => [ 'Io_argv1.tmp', '"echo foo |"' ],
+ args => [ 'tmpIo_argv1.tmp', '"echo foo |"' ],
);
like($x, qr/^Can't open echo foo \|: .* at -e line 1, <> line 3/, '<<>> does not treat ...| as fork after eof');
}
# This used to dump core
fresh_perl_is( <<'**PROG**', "foobar", {}, "ARGV aliasing and eof()" );
-open OUT, ">Io_argv3.tmp" or die "Can't open temp file: $!";
+open OUT, ">tmpIo_argv3.tmp" or die "Can't open temp file: $!";
print OUT "foo";
close OUT;
-open IN, "Io_argv3.tmp" or die "Can't open temp file: $!";
+open IN, "tmpIo_argv3.tmp" or die "Can't open temp file: $!";
*ARGV = *IN;
while (<>) {
print;
print "bar" if eof();
}
close IN;
-unlink "Io_argv3.tmp";
+unlink "tmpIo_argv3.tmp";
**PROG**
# This used to fail an assertion.
"ok\n", 'deleting $::{ARGV}';
END {
- unlink_all 'Io_argv1.tmp', 'Io_argv1.tmp_bak',
- 'Io_argv2.tmp', 'Io_argv2.tmp_bak', 'Io_argv3.tmp';
+ unlink_all 'tmpIo_argv1.tmp', 'tmpIo_argv1.tmp_bak',
+ 'tmpIo_argv2.tmp', 'tmpIo_argv2.tmp_bak', 'tmpIo_argv3.tmp';
}
}
# We need an external program to call.
-my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : ($Is_NetWare ? "echo$$" : "./echo$$"));
+my $ECHO = ($Is_MSWin32 ? ".\\tmpecho$$" : ($Is_NetWare ? "tmpecho$$" : "./tmpecho$$"));
END { unlink $ECHO }
open my $fh, '>', $ECHO or die "Can't create $ECHO: $!";
print $fh 'print "@ARGV\n"', "\n";
return 0;
}
- my $COREincdir = File::Spec->catdir(File::Spec->updir);
+ my $COREincdir =
+ File::Spec->catdir(File::Spec->updir, File::Spec->updir);
my $ccflags = $Config{'ccflags'} . ' ' . "-I$COREincdir"
. ' -DPERL_NO_INLINE_FUNCTIONS';
if ($^O eq "MSWin32") {
- $ccflags .= " -I../win32 -I../win32/include";
+ $ccflags .= " -I../../win32 -I../../win32/include";
}
my $libs = '';
"ok",
"");
-open my $fh, ">", "Oooof.pm" or die "Can't write Oooof.pm: $!";
-print $fh "package Oooof; 1;\n";
+open my $fh, ">", "tmpOooof.pm" or die "Can't write tmpOooof.pm: $!";
+print $fh "package tmpOooof; 1;\n";
close $fh;
-END { 1 while unlink "Oooof.pm" }
+END { 1 while unlink "tmpOooof.pm" }
-try({PERL5OPT => '-I. -MOooof'},
- ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'],
+try({PERL5OPT => '-I. -MtmpOooof'},
+ ['-e', 'print "ok" if $INC{"tmpOooof.pm"} eq "tmpOooof.pm"'],
"ok",
"");
-try({PERL5OPT => '-I./ -MOooof'},
- ['-e', 'print "ok" if $INC{"Oooof.pm"} eq "Oooof.pm"'],
+try({PERL5OPT => '-I./ -MtmpOooof'},
+ ['-e', 'print "ok" if $INC{"tmpOooof.pm"} eq "tmpOooof.pm"'],
"ok",
"");
{
local $TODO = ''; # these ones should work on VMS
- sub do_i_unlink { unlink_all("file", "file.bak") }
+ sub do_i_unlink { unlink_all("tmpswitches", "tmpswitches.bak") }
- open(FILE, ">file") or die "$0: Failed to create 'file': $!";
+ open(FILE, ">tmpswitches") or die "$0: Failed to create 'tmpswitches': $!";
my $yada = <<__EOF__;
foo yada dada
bada foo bing
END { do_i_unlink() }
- runperl( switches => ['-pi.bak'], prog => 's/foo/bar/', args => ['file'] );
+ runperl( switches => ['-pi.bak'], prog => 's/foo/bar/', args => ['tmpswitches'] );
- open(FILE, "file") or die "$0: Failed to open 'file': $!";
+ open(FILE, "tmpswitches") or die "$0: Failed to open 'tmpswitches': $!";
chomp(my @file = <FILE>);
close FILE;
- open(BAK, "file.bak") or die "$0: Failed to open 'file': $!";
+ open(BAK, "tmpswitches.bak") or die "$0: Failed to open 'tmpswitches.bak': $!";
chomp(my @bak = <BAK>);
close BAK;
prog => 'exit',
stderr => 1,
stdin => "1\n",
- args => ['file'],
+ args => ['tmpswitches'],
);
is($out2, "", "no warning when files given");
- open my $f, ">", "file" or die "$0: failed to create 'file': $!";
+ open my $f, ">", "tmpswitches" or die "$0: failed to create 'tmpswitches': $!";
print $f "foo\nbar\n";
close $f;
switches => [ '-i', '-p' ],
prog => 's/foo/quux/',
stderr => 1,
- args => [ 'file' ],
+ args => [ 'tmpswitches' ],
);
is($out3, "", "no warnings/errors without backup extension");
- open $f, "<", "file" or die "$0: cannot open 'file': $!";
+ open $f, "<", "tmpswitches" or die "$0: cannot open 'tmpswitches': $!";
chomp(my @out4 = <$f>);
close $f;
is(join(":", @out4), "quux:bar", "correct output without backup extension");
eval { require File::Spec; 1 }
or skip "Cannot load File::Spec - miniperl?", 20;
- -d "inplacetmp" or mkdir("inplacetmp")
- or die "Cannot mkdir 'inplacetmp': $!";
- my $work = File::Spec->catfile("inplacetmp", "foo");
+ -d "tmpinplace" or mkdir("tmpinplace")
+ or die "Cannot mkdir 'tmpinplace': $!";
+ my $work = File::Spec->catfile("tmpinplace", "foo");
# exit or die should leave original content in file
for my $inplace (qw/-i -i.bak/) {
&& $Config{d_linkat}
&& $Config{ccflags} !~ /-DNO_USE_ATFUNCTIONS\b/;
fresh_perl_is(<<'CODE', "ok\n", { },
-@ARGV = ("inplacetmp/foo");
+@ARGV = ("tmpinplace/foo");
$^I = "";
while (<>) {
chdir "..";
fresh_perl_is(<<'CODE', "ok\n", { stderr => 1 },
use threads;
use strict;
-@ARGV = ("inplacetmp/foo");
+@ARGV = ("tmpinplace/foo");
$^I = "";
while (<>) {
threads->create(sub { })->join;
close $fh or die "Cannot close $work: $!";
fresh_perl_is(<<'CODE', "ok\n", { stderr => 1 },
use strict;
-@ARGV = ("inplacetmp/foo");
+@ARGV = ("tmpinplace/foo");
$^I = "";
while (<>) {
my $pid = fork;
# make it fail by creating a directory of the backup name
mkdir "$work.bak" or die "Cannot make mask backup directory: $!";
fresh_perl_like(<<'CODE', qr/Can't rename/, { stderr => 1 }, "fail backup rename");
-@ARGV = ("inplacetmp/foo");
+@ARGV = ("tmpinplace/foo");
$^I = ".bak";
while (<>) {
print;
# we now use temp files for in-place editing, make sure we didn't leave
# any behind in the above test
- opendir my $d, "inplacetmp" or die "Cannot opendir inplacetmp: $!";
+ opendir my $d, "tmpinplace" or die "Cannot opendir tmpinplace: $!";
my @names = grep !/^\.\.?$/ && $_ ne 'foo', readdir $d;
closedir $d;
is(scalar(@names), 0, "no extra files")
# test we handle the rename of the work to the original failing
# make it fail by removing write perms from the directory
# but first check that doesn't prevent writing
- chmod 0500, "inplacetmp";
- my $check = File::Spec->catfile("inplacetmp", "check");
+ chmod 0500, "tmpinplace";
+ my $check = File::Spec->catfile("tmpinplace", "check");
my $canwrite = open my $fh, ">", $check;
unlink $check;
- chmod 0700, "inplacetmp" or die "Cannot make inplacetmp writable again: $!";
- skip "Cannot make inplacetmp read only", 1
+ chmod 0700, "tmpinplace" or die "Cannot make tmpinplace writable again: $!";
+ skip "Cannot make tmpinplace read only", 1
if $canwrite;
fresh_perl_like(<<'CODE', qr/Can't rename/, { stderr => 1 }, "fail final rename");
-@ARGV = ("inplacetmp/foo");
+@ARGV = ("tmpinplace/foo");
$^I = "";
while (<>) {
- chmod 0500, "inplacetmp";
+ chmod 0500, "tmpinplace";
print;
}
print "ok\n";
CODE
- chmod 0700, "inplacetmp" or die "Cannot make inplacetmp writable again: $!";
+ chmod 0700, "tmpinplace" or die "Cannot make tmpinplace writable again: $!";
}
SKIP:
&& ($Config{d_dirfd} || $Config{d_dir_dd_fd})
&& $Config{d_linkat}
&& $Config{ccflags} !~ /-DNO_USE_ATFUNCTIONS\b/;
- fresh_perl_like(<<'CODE', qr/^Cannot complete in-place edit of inplacetmp\/foo: .* - line 5, <> line \d+\./, { },
-@ARGV = ("inplacetmp/foo");
+ fresh_perl_like(<<'CODE', qr/^Cannot complete in-place edit of tmpinplace\/foo: .* - line 5, <> line \d+\./, { },
+@ARGV = ("tmpinplace/foo");
$^I = "";
while (<>) {
chdir "..";
unlink $work;
- opendir $d, "inplacetmp" or die "Cannot opendir inplacetmp: $!";
+ opendir $d, "tmpinplace" or die "Cannot opendir tmpinplace: $!";
@names = grep !/^\.\.?$/ && !/foo$/aai, readdir $d;
closedir $d;
# clean up in case the above failed
- unlink map File::Spec->catfile("inplacetmp", $_), @names;
+ unlink map File::Spec->catfile("tmpinplace", $_), @names;
- rmdir "inplacetmp";
+ rmdir "tmpinplace";
}
# Tests for -E
my $tempfile_count = 0;
sub tempfile {
while(1){
- my $try = "tmp$$";
+ my $try = (-d "t" ? "t/" : "")."tmp$$";
my $alpha = _num_to_alpha($tempfile_count,2);
last unless defined $alpha;
$try = $try . $alpha;