numeric.c:S_mulexp10 -- quit when you can

[perl5.git] / t / op / tiehandle.t

diff --git a/t/op/tiehandle.t b/t/op/tiehandle.t
index e3d2472..257a613 100755 (executable)
--- a/t/op/tiehandle.t
+++ b/t/op/tiehandle.t
@@ -64,7 +64,7 @@ sub READ {
 sub WRITE {
     compare(WRITE => @_);
     $data = substr($_[1],$_[3] || 0, $_[2]);
-    4;
+    length($data);
 }
 
 sub CLOSE {
@@ -77,7 +77,7 @@ package main;
 
 use Symbol;
 
-print "1..23\n";
+print "1..39\n";
 
 my $fh = gensym;
 
@@ -132,6 +132,101 @@ $r = syswrite $fh,$buf,4,1;
 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
+    local *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 {}}
+}
+
+{
+    # warnings should pass to the PRINT method of tied STDERR
+    my @received;
+
+    local *STDERR = *$fh;
+    local *Implement::PRINT = sub { @received = @_ };
+
+    $r = warn("some", "text", "\n");
+    @expect = (PRINT => $ob,"sometext\n");
+
+    Implement::compare(PRINT => @received);
+}
+