1 files changed, 137 insertions, 0 deletions
diff --git a/contrib/perl5/t/op/tiehandle.t b/contrib/perl5/t/op/tiehandle.t
new file mode 100755
index 0000000..e3d2472
--- /dev/null
+++ b/contrib/perl5/t/op/tiehandle.t
@@ -0,0 +1,137 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+my @expect;
+my $data = "";
+my @data = ();
+my $test = 1;
+
+sub ok { print "not " unless shift; print "ok ",$test++,"\n"; }
+
+package Implement;
+
+BEGIN { *ok = \*main::ok }
+
+sub compare {
+    return unless @expect;
+    return ok(0) unless(@_ == @expect);
+
+    my $i;
+    for($i = 0 ; $i < @_ ; $i++) {
+	next if $_[$i] eq $expect[$i];
+	return ok(0);
+    }
+
+    ok(1);
+}
+
+sub TIEHANDLE {
+    compare(TIEHANDLE => @_);
+    my ($class,@val) = @_;
+    return bless \@val,$class;
+}
+
+sub PRINT {
+    compare(PRINT => @_);
+    1;
+}
+
+sub PRINTF {
+    compare(PRINTF => @_);
+    2;
+}
+
+sub READLINE {
+    compare(READLINE => @_);
+    wantarray ? @data : shift @data;
+}
+
+sub GETC {
+    compare(GETC => @_);
+    substr($data,0,1);
+}
+
+sub READ {
+    compare(READ => @_);
+    substr($_[1],$_[3] || 0) = substr($data,0,$_[2]);
+    3;
+}
+
+sub WRITE {
+    compare(WRITE => @_);
+    $data = substr($_[1],$_[3] || 0, $_[2]);
+    4;
+}
+
+sub CLOSE {
+    compare(CLOSE => @_);
+    
+    5;
+}
+
+package main;
+
+use Symbol;
+
+print "1..23\n";
+
+my $fh = gensym;
+
+@expect = (TIEHANDLE => 'Implement');
+my $ob = tie *$fh,'Implement';
+ok(ref($ob) eq 'Implement');
+ok(tied(*$fh) == $ob);
+
+@expect = (PRINT => $ob,"some","text");
+$r = print $fh @expect[2,3];
+ok($r == 1);
+
+@expect = (PRINTF => $ob,"%s","text");
+$r = printf $fh @expect[2,3];
+ok($r == 2);
+
+$text = (@data = ("the line\n"))[0];
+@expect = (READLINE => $ob);
+$ln = <$fh>;
+ok($ln eq $text);
+
+@expect = ();
+@in = @data = qw(a line at a time);
+@line = <$fh>;
+@expect = @in;
+Implement::compare(@line);
+
+@expect = (GETC => $ob);
+$data = "abc";
+$ch = getc $fh;
+ok($ch eq "a");
+
+$buf = "xyz";
+@expect = (READ => $ob, $buf, 3);
+$data = "abc";
+$r = read $fh,$buf,3;
+ok($r == 3);
+ok($buf eq "abc");
+
+
+$buf = "xyzasd";
+@expect = (READ => $ob, $buf, 3,3);
+$data = "abc";
+$r = sysread $fh,$buf,3,3;
+ok($r == 3);
+ok($buf eq "xyzabc");
+
+$buf = "qwerty";
+@expect = (WRITE => $ob, $buf, 4,1);
+$data = "";
+$r = syswrite $fh,$buf,4,1;
+ok($r == 4);
+ok($data eq "wert");
+
+@expect = (CLOSE => $ob);
+$r = close $fh;
+ok($r == 5);