1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6} 7 8use Test::More; 9 10use_ok('Tie::StdHandle'); 11 12tie *tst,Tie::StdHandle; 13 14$f = 'tst'; 15 16unlink("afile") if -f "afile"; 17 18ok(open($f, "+>", "afile"), "open +>, afile"); 19ok(open($f, "+<", "afile"), "open +<, afile"); 20ok(binmode($f), "binmode") 21 or diag("binmode: $!\n"); 22 23ok(-f "afile", "-f afile"); 24 25# write some lines 26 27ok(print($f "SomeData\n"), "print SomeData"); # line 1 28is(tell($f), 9, "tell"); 29ok(printf($f "Some %d value\n",1234), "printf"); # line 2 30ok(print($f "ABCDEF\n"), "print ABCDEF"); # line 3 31{ 32 local $\ = "X\n"; 33 ok(print($f "rhubarb"), "print rhubarb"); # line 4 34} 35 36ok(syswrite($f, "123456789\n", 3, 7), "syswrite");# line 5 37 38# read some lines back 39 40ok(seek($f,0,0), "seek"); 41 42# line 1 43# 44$b = <$f>; 45is($b, "SomeData\n", "b eq SomeData"); 46ok(!eof($f), "!eof"); 47 48#line 2 49 50is(read($f,($b=''),4), 4, "read(4)"); 51is($b, 'Some', "b eq Some"); 52is(getc($f), ' ', "getc"); 53$b = <$f>; 54is($b, "1234 value\n", "b eq 1234 value"); 55ok(!eof($f), "eof"); 56 57# line 3 58 59is(read($f,($b='scrinches'),4,4), 4, "read(4,4)"); # with offset 60is($b, 'scriABCD', "b eq scriABCD"); 61$b = <$f>; 62is($b, "EF\n", "EF"); 63ok(!eof($f), "eof"); 64 65# line 4 66 67$b = <$f>; 68is($b, "rhubarbX\n", "b eq rhubarbX"); 69 70# line 5 71 72$b = <$f>; 73is($b, "89\n", "b eq 89"); 74 75# binmode should pass through layer argument 76 77binmode $f, ':raw'; 78ok !grep( $_ eq 'utf8', PerlIO::get_layers(tied(*$f)) ), 79 'no utf8 in layers after binmode :raw'; 80binmode $f, ':utf8'; 81ok grep( $_ eq 'utf8', PerlIO::get_layers(tied(*$f)) ), 82 'utf8 is in layers after binmode :utf8'; 83 84# finish up 85 86ok(eof($f), "eof"); 87ok(close($f), "close"); 88 89unlink("afile"); 90 91done_testing(); 92