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;

}