sub WRITE {
compare(WRITE => @_);
$data = substr($_[1],$_[3] || 0, $_[2]);
- 4;
+ length($data);
}
sub CLOSE {
use Symbol;
-print "1..23\n";
+print "1..38\n";
my $fh = gensym;
ok($r == 4);
ok($data eq "wert");
+$buf = "qwerty";
+@expect = (WRITE => $ob, $buf, 4);
+$data = "";
+$r = syswrite $fh,$buf,4;
+ok($r == 4);
+ok($data eq "qwer");
+
+$buf = "qwerty";
+@expect = (WRITE => $ob, $buf, 6);
+$data = "";
+$r = syswrite $fh,$buf;
+ok($r == 6);
+ok($data eq "qwerty");
+
@expect = (CLOSE => $ob);
$r = close $fh;
ok($r == 5);
+
+# Does aliasing work with tied FHs?
+*ALIAS = *$fh;
+@expect = (PRINT => $ob,"some","text");
+$r = print ALIAS @expect[2,3];
+ok($r == 1);
+
+{
+ use warnings;
+ # Special case of aliasing STDERR, which used
+ # to dump core when warnings were enabled
+ *STDERR = *$fh;
+ @expect = (PRINT => $ob,"some","text");
+ $r = print STDERR @expect[2,3];
+ ok($r == 1);
+}
+
+{
+ # Test for change #11536
+ package Foo;
+ use strict;
+ sub TIEHANDLE { bless {} }
+ my $cnt = 'a';
+ sub READ {
+ $_[1] = $cnt++;
+ 1;
+ }
+ sub do_read {
+ my $fh = shift;
+ read $fh, my $buff, 1;
+ main::ok(1);
+ }
+ $|=1;
+ tie *STDIN, 'Foo';
+ read STDIN, my $buff, 1;
+ main::ok(1);
+ do_read(\*STDIN);
+ untie *STDIN;
+}
+
+
+{
+ # test for change 11639: Can't localize *FH, then tie it
+ {
+ local *foo;
+ tie %foo, 'Blah';
+ }
+ ok(!tied %foo);
+
+ {
+ local *bar;
+ tie @bar, 'Blah';
+ }
+ ok(!tied @bar);
+
+ {
+ local *BAZ;
+ tie *BAZ, 'Blah';
+ }
+ ok(!tied *BAZ);
+
+ package Blah;
+
+ sub TIEHANDLE {bless {}}
+ sub TIEHASH {bless {}}
+ sub TIEARRAY {bless {}}
+}
+