1BEGIN { 2 chdir 't' if -d 't'; 3 @INC = '../lib'; 4 require Config; import Config; 5 unless (find PerlIO::Layer 'perlio') { 6 print "1..0 # Skip: PerlIO not used\n"; 7 exit 0; 8 } 9} 10 11use Test::More tests => 37; 12 13use_ok('PerlIO'); 14 15my $txt = "txt$$"; 16my $bin = "bin$$"; 17my $utf = "utf$$"; 18 19my $txtfh; 20my $binfh; 21my $utffh; 22 23ok(open($txtfh, ">:crlf", $txt)); 24 25ok(open($binfh, ">:raw", $bin)); 26 27ok(open($utffh, ">:utf8", $utf)); 28 29print $txtfh "foo\n"; 30print $txtfh "bar\n"; 31 32ok(close($txtfh)); 33 34print $binfh "foo\n"; 35print $binfh "bar\n"; 36 37ok(close($binfh)); 38 39print $utffh "foo\x{ff}\n"; 40print $utffh "bar\x{abcd}\n"; 41 42ok(close($utffh)); 43 44ok(open($txtfh, "<:crlf", $txt)); 45 46ok(open($binfh, "<:raw", $bin)); 47 48 49ok(open($utffh, "<:utf8", $utf)); 50 51is(scalar <$txtfh>, "foo\n"); 52is(scalar <$txtfh>, "bar\n"); 53 54is(scalar <$binfh>, "foo\n"); 55is(scalar <$binfh>, "bar\n"); 56 57is(scalar <$utffh>, "foo\x{ff}\n"); 58is(scalar <$utffh>, "bar\x{abcd}\n"); 59 60ok(eof($txtfh));; 61 62ok(eof($binfh)); 63 64ok(eof($utffh)); 65 66ok(close($txtfh)); 67 68ok(close($binfh)); 69 70ok(close($utffh)); 71 72# magic temporary file via 3 arg open with undef 73{ 74 ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef'); 75 ok( defined fileno($x), ' fileno' ); 76 77 select $x; 78 ok( (print "ok\n"), ' print' ); 79 80 select STDOUT; 81 ok( seek($x,0,0), ' seek' ); 82 is( scalar <$x>, "ok\n", ' readline' ); 83 ok( tell($x) >= 3, ' tell' ); 84 85 # test magic temp file over STDOUT 86 open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!"; 87 my $status = open(STDOUT,"+<",undef); 88 open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!"; 89 # report after STDOUT is restored 90 ok($status, ' re-open STDOUT'); 91 close OLDOUT; 92} 93 94# in-memory open 95{ 96 my $var; 97 ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var'); 98 ok( defined fileno($x), ' fileno' ); 99 100 select $x; 101 ok( (print "ok\n"), ' print' ); 102 103 select STDOUT; 104 ok( seek($x,0,0), ' seek' ); 105 is( scalar <$x>, "ok\n", ' readline' ); 106 ok( tell($x) >= 3, ' tell' ); 107 108 TODO: { 109 local $TODO = "broken"; 110 111 # test in-memory open over STDOUT 112 open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!"; 113 #close STDOUT; 114 my $status = open(STDOUT,">",\$var); 115 my $error = "$!" unless $status; # remember the error 116 close STDOUT unless $status; 117 open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!"; 118 print "# $error\n" unless $status; 119 # report after STDOUT is restored 120 ok($status, ' open STDOUT into in-memory var'); 121 122 # test in-memory open over STDERR 123 open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!"; 124 #close STDERR; 125 ok( open(STDERR,">",\$var), ' open STDERR into in-memory var'); 126 open STDERR, ">&OLDERR" or die "cannot dup OLDERR: $!"; 127 } 128} 129 130 131END { 132 1 while unlink $txt; 133 1 while unlink $bin; 134 1 while unlink $utf; 135} 136 137