This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
applied suggested patch with small doc tweak
[perl5.git] / t / op / tiehandle.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6 }
7
8 my @expect;
9 my $data = "";
10 my @data = ();
11 my $test = 1;
12
13 sub ok { print "not " unless shift; print "ok ",$test++,"\n"; }
14
15 package Implement;
16
17 BEGIN { *ok = \*main::ok }
18
19 sub compare {
20     return unless @expect;
21     return ok(0) unless(@_ == @expect);
22
23     my $i;
24     for($i = 0 ; $i < @_ ; $i++) {
25         next if $_[$i] eq $expect[$i];
26         return ok(0);
27     }
28
29     ok(1);
30 }
31
32 sub TIEHANDLE {
33     compare(TIEHANDLE => @_);
34     my ($class,@val) = @_;
35     return bless \@val,$class;
36 }
37
38 sub PRINT {
39     compare(PRINT => @_);
40     1;
41 }
42
43 sub PRINTF {
44     compare(PRINTF => @_);
45     2;
46 }
47
48 sub READLINE {
49     compare(READLINE => @_);
50     wantarray ? @data : shift @data;
51 }
52
53 sub GETC {
54     compare(GETC => @_);
55     substr($data,0,1);
56 }
57
58 sub READ {
59     compare(READ => @_);
60     substr($_[1],$_[3] || 0) = substr($data,0,$_[2]);
61     3;
62 }
63
64 sub WRITE {
65     compare(WRITE => @_);
66     $data = substr($_[1],$_[3] || 0, $_[2]);
67     length($data);
68 }
69
70 sub CLOSE {
71     compare(CLOSE => @_);
72     
73     5;
74 }
75
76 package main;
77
78 use Symbol;
79
80 print "1..29\n";
81
82 my $fh = gensym;
83
84 @expect = (TIEHANDLE => 'Implement');
85 my $ob = tie *$fh,'Implement';
86 ok(ref($ob) eq 'Implement');
87 ok(tied(*$fh) == $ob);
88
89 @expect = (PRINT => $ob,"some","text");
90 $r = print $fh @expect[2,3];
91 ok($r == 1);
92
93 @expect = (PRINTF => $ob,"%s","text");
94 $r = printf $fh @expect[2,3];
95 ok($r == 2);
96
97 $text = (@data = ("the line\n"))[0];
98 @expect = (READLINE => $ob);
99 $ln = <$fh>;
100 ok($ln eq $text);
101
102 @expect = ();
103 @in = @data = qw(a line at a time);
104 @line = <$fh>;
105 @expect = @in;
106 Implement::compare(@line);
107
108 @expect = (GETC => $ob);
109 $data = "abc";
110 $ch = getc $fh;
111 ok($ch eq "a");
112
113 $buf = "xyz";
114 @expect = (READ => $ob, $buf, 3);
115 $data = "abc";
116 $r = read $fh,$buf,3;
117 ok($r == 3);
118 ok($buf eq "abc");
119
120
121 $buf = "xyzasd";
122 @expect = (READ => $ob, $buf, 3,3);
123 $data = "abc";
124 $r = sysread $fh,$buf,3,3;
125 ok($r == 3);
126 ok($buf eq "xyzabc");
127
128 $buf = "qwerty";
129 @expect = (WRITE => $ob, $buf, 4,1);
130 $data = "";
131 $r = syswrite $fh,$buf,4,1;
132 ok($r == 4);
133 ok($data eq "wert");
134
135 $buf = "qwerty";
136 @expect = (WRITE => $ob, $buf, 4);
137 $data = "";
138 $r = syswrite $fh,$buf,4;
139 ok($r == 4);
140 ok($data eq "qwer");
141
142 $buf = "qwerty";
143 @expect = (WRITE => $ob, $buf, 6);
144 $data = "";
145 $r = syswrite $fh,$buf;
146 ok($r == 6);
147 ok($data eq "qwerty");
148
149 @expect = (CLOSE => $ob);
150 $r = close $fh;
151 ok($r == 5);