use test.pl's tempfile().
p4raw-id: //depot/perl@34182
require "test.pl";
-my $file = "crlf$$.dat";
-END {
- 1 while unlink($file);
-}
+my $file = tempfile();
if (find PerlIO::Layer 'perlio') {
plan(tests => 16);
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;
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";
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"));
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");
}
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";
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);
}
close UTFIN;
- END { 1 while unlink "dup$$" }
}
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;
# 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;
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
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;
} 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;
}
print file_eq($f, "Perl") ? "ok 1\n" : "not ok 1\n";
- push @delete, $f;
}
# Test flush on system/qx/pipe open
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;
}
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';
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);
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;
}
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: {
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;
}
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;
}
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');
# 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
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; }
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);',
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);',
$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) ],
{
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) ],
# 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";
}
#!./perl
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require "./test.pl";
+}
+
print "1..5\n";
my $j = 1;
}
}
+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) }
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' );
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' );
}
{
- 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 -|' );
}
-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' );
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);
}
{
}
-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;
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');
}
plan tests => 2;
-open(A,"+>a");
+my $tmpfile = tempfile();
+
+open(A,"+>$tmpfile");
print A "_";
seek(A,0,0);
close(A);
-unlink("a");
-
is($b,"\000\000\000\000_"); # otherwise probably "\000bcd_"
-unlink 'a';
-
SKIP: {
skip "no EBADF", 1 if (!exists &Errno::EBADF);
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
+ require './test.pl';
}
print "1..28\n";
# 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:$!";
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;
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");
}
}
-unlink 'io_io.tmp';
-
1;
$| = 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";
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);
$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;
close F;
- open F, "a" or die $!; # Not UTF
+ open F, $a_file or die $!; # Not UTF
binmode(F, ":bytes");
$x = <F>;
chomp($x);
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.
}
# 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;
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: {
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 };
}
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;
my $c;
# read() should work on characters, not bytes
-open F, "<:utf8", "a";
+open F, "<:utf8", $a_file;
$a = 0;
my $failed;
for (@a) {
local $SIG{__WARN__} = sub { $@ = shift };
undef $@;
- open F, ">a";
+ open F, ">$a_file";
binmode(F, ":bytes");
print F chr(0x100);
close(F);
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);
no warnings 'utf8';
undef $@;
- open F, ">a";
+ open F, ">$a_file";
print F chr(0x100);
close(F);
use warnings 'utf8';
undef $@;
- open F, ">a";
+ open F, ">$a_file";
binmode(F, ":bytes");
print F chr(0x100);
close(F);
}
{
- 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" );
}
{
- 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" );
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]);
{
# [perl #23428] Somethings rotten in unicode semantics
- open F, ">a";
+ open F, ">$a_file";
binmode F, ":utf8";
syswrite(F, $a = chr(0x100));
close F;
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
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");
"<:utf8 rcatline must warn about bad utf8");
close F;
}
-
-END {
- 1 while unlink "a";
- 1 while unlink "b";
-}
projects / platform / upstream / perl.git / commitdiff