...and put some of the new perlio tests here.

The in-memory ones not yet since my poor brain
refuses to find the right TODO incantation.

p4raw-id: //depot/perl@15499

diff --git a/ext/PerlIO/PerlIO.t b/ext/PerlIO/PerlIO.t
index e28a409..5514191 100644 (file)
--- a/ext/PerlIO/PerlIO.t
+++ b/ext/PerlIO/PerlIO.t
@@ -8,11 +8,9 @@ BEGIN {
        }
 }
 
-use PerlIO;
+use Test::More tests => 35;
 
-print "1..19\n";
-
-print "ok 1\n";
+use_ok('PerlIO');
 
 my $txt = "txt$$";
 my $bin = "bin$$";
@@ -22,65 +20,91 @@ my $txtfh;
 my $binfh;
 my $utffh;
 
-print "not " unless open($txtfh, ">:crlf", $txt);
-print "ok 2\n";
+ok(open($txtfh, ">:crlf", $txt));
 
-print "not " unless open($binfh, ">:raw",  $bin);
-print "ok 3\n";
+ok(open($binfh, ">:raw",  $bin));
 
-print "not " unless open($utffh, ">:utf8", $utf);
+ok(open($utffh, ">:utf8", $utf));
 print "ok 4\n";
 
 print $txtfh "foo\n";
 print $txtfh "bar\n";
-print "not " unless close($txtfh);
-print "ok 5\n";
+
+ok(close($txtfh));
 
 print $binfh "foo\n";
 print $binfh "bar\n";
-print "not " unless close($binfh);
-print "ok 6\n";
+
+ok(close($binfh));
 
 print $utffh "foo\x{ff}\n";
 print $utffh "bar\x{abcd}\n";
-print "not " unless close($utffh);
-print "ok 7\n";
 
-print "not " unless open($txtfh, "<:crlf", $txt);
-print "ok 8\n";
+ok(close($utffh));
+
+ok(open($txtfh, "<:crlf", $txt));
+
+ok(open($binfh, "<:raw",  $bin));
+
+
+ok(open($utffh, "<:utf8", $utf));
 
-print "not " unless open($binfh, "<:raw",  $bin);
-print "ok 9\n";
+is(scalar <$txtfh>, "foo\n");
+is(scalar <$txtfh>, "bar\n");
 
-print "not " unless open($utffh, "<:utf8", $utf);
-print "ok 10\n";
+is(scalar <$binfh>, "foo\n");
+is(scalar <$binfh>, "bar\n");
 
-print "not " unless <$txtfh> eq "foo\n" && <$txtfh> eq "bar\n";
-print "ok 11\n";
+is(scalar <$utffh>,  "foo\x{ff}\n");
+is(scalar <$utffh>, "bar\x{abcd}\n");
 
-print "not " unless <$binfh> eq "foo\n" && <$binfh> eq "bar\n";
-print "ok 12\n";
+ok(eof($txtfh));;
 
-print "not " unless <$utffh> eq "foo\x{ff}\n" && <$utffh> eq "bar\x{abcd}\n";
-print "ok 13\n";
+ok(eof($binfh));
 
-print "not " unless eof($txtfh);
-print "ok 14\n";
+ok(eof($utffh));
 
-print "not " unless eof($binfh);
-print "ok 15\n";
+ok(close($txtfh));
 
-print "not " unless eof($utffh);
-print "ok 16\n";
+ok(close($binfh));
 
-print "not " unless close($txtfh);
-print "ok 17\n";
+ok(close($utffh));
 
-print "not " unless close($binfh);
-print "ok 18\n";
+# 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' );
 
-print "not " unless close($utffh);
-print "ok 19\n";
+    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');
+}
+
+# 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' );
+}
 
 END {
     1 while unlink $txt;