BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
unless (find PerlIO::Layer 'perlio') {
print "1..0 # Skip: PerlIO not used\n";
exit 0;
}
}
use Test::More tests => 37;
use_ok('PerlIO');
my $txt = "txt$$";
my $bin = "bin$$";
my $utf = "utf$$";
my $txtfh;
my $binfh;
my $utffh;
ok(open($txtfh, ">:crlf", $txt));
ok(open($binfh, ">:raw", $bin));
ok(open($utffh, ">:utf8", $utf));
print $txtfh "foo\n";
print $txtfh "bar\n";
ok(close($txtfh));
print $binfh "foo\n";
print $binfh "bar\n";
ok(close($binfh));
print $utffh "foo\x{ff}\n";
print $utffh "bar\x{abcd}\n";
ok(close($utffh));
ok(open($txtfh, "<:crlf", $txt));
ok(open($binfh, "<:raw", $bin));
ok(open($utffh, "<:utf8", $utf));
is(scalar <$txtfh>, "foo\n");
is(scalar <$txtfh>, "bar\n");
is(scalar <$binfh>, "foo\n");
is(scalar <$binfh>, "bar\n");
is(scalar <$utffh>, "foo\x{ff}\n");
is(scalar <$utffh>, "bar\x{abcd}\n");
ok(eof($txtfh));;
ok(eof($binfh));
ok(eof($utffh));
ok(close($txtfh));
ok(close($binfh));
ok(close($utffh));
# magic temporary file via 3 arg open with undef
{
ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');
ok( defined fileno($x), ' fileno' );
select $x;
ok( (print "ok\n"), ' print' );
select STDOUT;
ok( seek($x,0,0), ' seek' );
is( scalar <$x>, "ok\n", ' readline' );
ok( tell($x) >= 3, ' tell' );
# test magic temp file over STDOUT
open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
my $status = open(STDOUT,"+<",undef);
open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!";
# report after STDOUT is restored
ok($status, ' re-open STDOUT');
close OLDOUT;
}
# in-memory open
{
my $var;
ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');
ok( defined fileno($x), ' fileno' );
select $x;
ok( (print "ok\n"), ' print' );
select STDOUT;
ok( seek($x,0,0), ' seek' );
is( scalar <$x>, "ok\n", ' readline' );
ok( tell($x) >= 3, ' tell' );
TODO: {
local $TODO = "broken";
# test in-memory open over STDOUT
open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
#close STDOUT;
my $status = open(STDOUT,">",\$var);
my $error = "$!" unless $status; # remember the error
close STDOUT unless $status;
open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!";
print "# $error\n" unless $status;
# report after STDOUT is restored
ok($status, ' open STDOUT into in-memory var');
# test in-memory open over STDERR
open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!";
#close STDERR;
ok( open(STDERR,">",\$var), ' open STDERR into in-memory var');
open STDERR, ">&OLDERR" or die "cannot dup OLDERR: $!";
}
}
END {
1 while unlink $txt;
1 while unlink $bin;
1 while unlink $utf;
}
|