Fix test added in change 23645 with an eval()

[p5sagit/p5-mst-13.2.git] / t / op / tiehandle.t

diff --git a/t/op/tiehandle.t b/t/op/tiehandle.t
index 257a613..c679c58 100755 (executable)
--- a/t/op/tiehandle.t
+++ b/t/op/tiehandle.t
@@ -1,4 +1,4 @@
-#!./perl
+#!./perl -w
 
 BEGIN {
     chdir 't' if -d 't';
@@ -8,67 +8,65 @@ BEGIN {
 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 }
+require './test.pl';
+plan(tests => 41);
 
 sub compare {
     return unless @expect;
-    return ok(0) unless(@_ == @expect);
+    return ::fail() unless(@_ == @expect);
 
-    my $i;
-    for($i = 0 ; $i < @_ ; $i++) {
+    for my $i (0..$#_) {
        next if $_[$i] eq $expect[$i];
-       return ok(0);
+       return ::fail();
     }
 
-    ok(1);
+    ::pass();
 }
 
+
+package Implement;
+
 sub TIEHANDLE {
-    compare(TIEHANDLE => @_);
+    ::compare(TIEHANDLE => @_);
     my ($class,@val) = @_;
     return bless \@val,$class;
 }
 
 sub PRINT {
-    compare(PRINT => @_);
+    ::compare(PRINT => @_);
     1;
 }
 
 sub PRINTF {
-    compare(PRINTF => @_);
+    ::compare(PRINTF => @_);
     2;
 }
 
 sub READLINE {
-    compare(READLINE => @_);
+    ::compare(READLINE => @_);
     wantarray ? @data : shift @data;
 }
 
 sub GETC {
-    compare(GETC => @_);
+    ::compare(GETC => @_);
     substr($data,0,1);
 }
 
 sub READ {
-    compare(READ => @_);
+    ::compare(READ => @_);
     substr($_[1],$_[3] || 0) = substr($data,0,$_[2]);
     3;
 }
 
 sub WRITE {
-    compare(WRITE => @_);
+    ::compare(WRITE => @_);
     $data = substr($_[1],$_[3] || 0, $_[2]);
     length($data);
 }
 
 sub CLOSE {
-    compare(CLOSE => @_);
+    ::compare(CLOSE => @_);
     
     5;
 }
@@ -77,84 +75,82 @@ package main;
 
 use Symbol;
 
-print "1..39\n";
-
 my $fh = gensym;
 
 @expect = (TIEHANDLE => 'Implement');
 my $ob = tie *$fh,'Implement';
-ok(ref($ob) eq 'Implement');
-ok(tied(*$fh) == $ob);
+is(ref($ob),  'Implement');
+is(tied(*$fh), $ob);
 
 @expect = (PRINT => $ob,"some","text");
 $r = print $fh @expect[2,3];
-ok($r == 1);
+is($r, 1);
 
 @expect = (PRINTF => $ob,"%s","text");
 $r = printf $fh @expect[2,3];
-ok($r == 2);
+is($r, 2);
 
 $text = (@data = ("the line\n"))[0];
 @expect = (READLINE => $ob);
 $ln = <$fh>;
-ok($ln eq $text);
+is($ln, $text);
 
 @expect = ();
 @in = @data = qw(a line at a time);
 @line = <$fh>;
 @expect = @in;
-Implement::compare(@line);
+compare(@line);
 
 @expect = (GETC => $ob);
 $data = "abc";
 $ch = getc $fh;
-ok($ch eq "a");
+is($ch, "a");
 
 $buf = "xyz";
 @expect = (READ => $ob, $buf, 3);
 $data = "abc";
 $r = read $fh,$buf,3;
-ok($r == 3);
-ok($buf eq "abc");
+is($r, 3);
+is($buf, "abc");
 
 
 $buf = "xyzasd";
 @expect = (READ => $ob, $buf, 3,3);
 $data = "abc";
 $r = sysread $fh,$buf,3,3;
-ok($r == 3);
-ok($buf eq "xyzabc");
+is($r, 3);
+is($buf, "xyzabc");
 
 $buf = "qwerty";
 @expect = (WRITE => $ob, $buf, 4,1);
 $data = "";
 $r = syswrite $fh,$buf,4,1;
-ok($r == 4);
-ok($data eq "wert");
+is($r, 4);
+is($data, "wert");
 
 $buf = "qwerty";
 @expect = (WRITE => $ob, $buf, 4);
 $data = "";
 $r = syswrite $fh,$buf,4;
-ok($r == 4);
-ok($data eq "qwer");
+is($r, 4);
+is($data, "qwer");
 
 $buf = "qwerty";
 @expect = (WRITE => $ob, $buf, 6);
 $data = "";
 $r = syswrite $fh,$buf;
-ok($r == 6);
-ok($data eq "qwerty");
+is($r, 6);
+is($data, "qwerty");
 
 @expect = (CLOSE => $ob);
 $r = close $fh;
-ok($r == 5);
+is($r, 5);
 
 # Does aliasing work with tied FHs?
 *ALIAS = *$fh;
 @expect = (PRINT => $ob,"some","text");
 $r = print ALIAS @expect[2,3];
-ok($r == 1);
+is($r, 1);
 
 {
     use warnings;
@@ -163,7 +159,7 @@ ok($r == 1);
     local *STDERR = *$fh;
     @expect = (PRINT => $ob,"some","text");
     $r = print STDERR @expect[2,3];
-    ok($r == 1);
+    is($r, 1);
 }
 
 {
@@ -179,12 +175,12 @@ ok($r == 1);
     sub do_read {
        my $fh = shift;
        read $fh, my $buff, 1;
-       main::ok(1);
+       ::pass();
     }
     $|=1;
     tie *STDIN, 'Foo';
     read STDIN, my $buff, 1;
-    main::ok(1);
+    ::pass();
     do_read(\*STDIN);
     untie *STDIN;
 }
@@ -222,11 +218,31 @@ ok($r == 1);
     my @received;
 
     local *STDERR = *$fh;
+    no warnings 'redefine';
     local *Implement::PRINT = sub { @received = @_ };
 
     $r = warn("some", "text", "\n");
     @expect = (PRINT => $ob,"sometext\n");
 
-    Implement::compare(PRINT => @received);
+    compare(PRINT => @received);
+
+    use warnings;
+    print undef;
+
+    like($received[1], qr/Use of uninitialized value/);
 }
 
+{
+    # [ID 20020713.001] chomp($data=<tied_fh>)
+    local *TEST;
+    tie *TEST, 'CHOMP';
+    my $data;
+    chomp($data = <TEST>);
+    is($data, 'foobar');
+
+    package CHOMP;
+    sub TIEHANDLE { bless {}, $_[0] }
+    sub READLINE { "foobar\n" }
+}
+
+