1N/ABEGIN {

1N/A chdir 't' if -d 't';

1N/A @INC = '../lib';

1N/A require Config; import Config;

1N/A unless (find PerlIO::Layer 'perlio') {

1N/A print "1..0 # Skip: PerlIO not used\n";

1N/A exit 0;

1N/A }

1N/A}

1N/A

1N/Ause Test::More tests => 37;

1N/A

1N/Ause_ok('PerlIO');

1N/A

1N/Amy $txt = "txt$$";

1N/Amy $bin = "bin$$";

1N/Amy $utf = "utf$$";

1N/A

1N/Amy $txtfh;

1N/Amy $binfh;

1N/Amy $utffh;

1N/A

1N/Aok(open($txtfh, ">:crlf", $txt));

1N/A

1N/Aok(open($binfh, ">:raw", $bin));

1N/A

1N/Aok(open($utffh, ">:utf8", $utf));

1N/A

1N/Aprint $txtfh "foo\n";

1N/Aprint $txtfh "bar\n";

1N/A

1N/Aok(close($txtfh));

1N/A

1N/Aprint $binfh "foo\n";

1N/Aprint $binfh "bar\n";

1N/A

1N/Aok(close($binfh));

1N/A

1N/Aprint $utffh "foo\x{ff}\n";

1N/Aprint $utffh "bar\x{abcd}\n";

1N/A

1N/Aok(close($utffh));

1N/A

1N/Aok(open($txtfh, "<:crlf", $txt));

1N/A

1N/Aok(open($binfh, "<:raw", $bin));

1N/A

1N/A

1N/Aok(open($utffh, "<:utf8", $utf));

1N/A

1N/Ais(scalar <$txtfh>, "foo\n");

1N/Ais(scalar <$txtfh>, "bar\n");

1N/A

1N/Ais(scalar <$binfh>, "foo\n");

1N/Ais(scalar <$binfh>, "bar\n");

1N/A

1N/Ais(scalar <$utffh>, "foo\x{ff}\n");

1N/Ais(scalar <$utffh>, "bar\x{abcd}\n");

1N/A

1N/Aok(eof($txtfh));;

1N/A

1N/Aok(eof($binfh));

1N/A

1N/Aok(eof($utffh));

1N/A

1N/Aok(close($txtfh));

1N/A

1N/Aok(close($binfh));

1N/A

1N/Aok(close($utffh));

1N/A

1N/A# magic temporary file via 3 arg open with undef

1N/A{

1N/A ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');

1N/A ok( defined fileno($x), ' fileno' );

1N/A

1N/A select $x;

1N/A ok( (print "ok\n"), ' print' );

1N/A

1N/A select STDOUT;

1N/A ok( seek($x,0,0), ' seek' );

1N/A is( scalar <$x>, "ok\n", ' readline' );

1N/A ok( tell($x) >= 3, ' tell' );

1N/A

1N/A # test magic temp file over STDOUT

1N/A open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";

1N/A my $status = open(STDOUT,"+<",undef);

1N/A open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!";

1N/A # report after STDOUT is restored

1N/A ok($status, ' re-open STDOUT');

1N/A close OLDOUT;

1N/A}

1N/A

1N/A# in-memory open

1N/A{

1N/A my $var;

1N/A ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');

1N/A ok( defined fileno($x), ' fileno' );

1N/A

1N/A select $x;

1N/A ok( (print "ok\n"), ' print' );

1N/A

1N/A select STDOUT;

1N/A ok( seek($x,0,0), ' seek' );

1N/A is( scalar <$x>, "ok\n", ' readline' );

1N/A ok( tell($x) >= 3, ' tell' );

1N/A

1N/A TODO: {

1N/A local $TODO = "broken";

1N/A

1N/A # test in-memory open over STDOUT

1N/A open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";

1N/A #close STDOUT;

1N/A my $status = open(STDOUT,">",\$var);

1N/A my $error = "$!" unless $status; # remember the error

1N/A close STDOUT unless $status;

1N/A open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!";

1N/A print "# $error\n" unless $status;

1N/A # report after STDOUT is restored

1N/A ok($status, ' open STDOUT into in-memory var');

1N/A

1N/A # test in-memory open over STDERR

1N/A open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!";

1N/A #close STDERR;

1N/A ok( open(STDERR,">",\$var), ' open STDERR into in-memory var');

1N/A open STDERR, ">&OLDERR" or die "cannot dup OLDERR: $!";

1N/A }

1N/A}

1N/A

1N/A

1N/AEND {

1N/A 1 while unlink $txt;

1N/A 1 while unlink $bin;

1N/A 1 while unlink $utf;

1N/A}

1N/A