This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add '=cut' to silence POD formatting warning
[perl5.git] / lib / Tie / Handle / stdhandle.t
CommitLineData
4592e6ca
NIS
1#!./perl
2
3BEGIN {
4 chdir 't' if -d 't';
20822f61 5 @INC = '../lib';
4592e6ca
NIS
6}
7
70cbce25 8use Test::More;
00db94a9
DM
9
10use_ok('Tie::StdHandle');
11
4592e6ca
NIS
12tie *tst,Tie::StdHandle;
13
14$f = 'tst';
15
7a6da24c 16unlink("afile") if -f "afile";
4592e6ca 17
1ae6ead9 18ok(open($f, "+>", "afile"), "open +>, afile");
00db94a9
DM
19ok(open($f, "+<", "afile"), "open +<, afile");
20ok(binmode($f), "binmode")
21 or diag("binmode: $!\n");
22
23ok(-f "afile", "-f afile");
24
2cf89ea7
AS
25# write some lines
26
27ok(print($f "SomeData\n"), "print SomeData"); # line 1
00db94a9 28is(tell($f), 9, "tell");
2cf89ea7
AS
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
3c41103a
DM
36ok(syswrite($f, "123456789\n", 3, 7), "syswrite");# line 5
37
2cf89ea7
AS
38# read some lines back
39
00db94a9 40ok(seek($f,0,0), "seek");
4592e6ca 41
2cf89ea7
AS
42# line 1
43#
4592e6ca 44$b = <$f>;
00db94a9
DM
45is($b, "SomeData\n", "b eq SomeData");
46ok(!eof($f), "!eof");
47
2cf89ea7
AS
48#line 2
49
00db94a9
DM
50is(read($f,($b=''),4), 4, "read(4)");
51is($b, 'Some', "b eq Some");
52is(getc($f), ' ', "getc");
4592e6ca 53$b = <$f>;
2cf89ea7
AS
54is($b, "1234 value\n", "b eq 1234 value");
55ok(!eof($f), "eof");
56
57# line 3
58
00db94a9 59is(read($f,($b='scrinches'),4,4), 4, "read(4,4)"); # with offset
2cf89ea7
AS
60is($b, 'scriABCD', "b eq scriABCD");
61$b = <$f>;
62is($b, "EF\n", "EF");
63ok(!eof($f), "eof");
64
65# line 4
00db94a9 66
2cf89ea7
AS
67$b = <$f>;
68is($b, "rhubarbX\n", "b eq rhubarbX");
69
3c41103a
DM
70# line 5
71
72$b = <$f>;
73is($b, "89\n", "b eq 89");
74
a4e94e39
H
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
2cf89ea7 86ok(eof($f), "eof");
00db94a9
DM
87ok(close($f), "close");
88
052b629e 89unlink("afile");
70cbce25
MB
90
91done_testing();