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