[perl #60978] [PATCH] Tied filehandles can't distinguish eof forms

Message-ID: <20081210224524.GD18817@tytlal.topaz.cx>

p4raw-id: //depot/perl@35074

diff --git a/pod/perltie.pod b/pod/perltie.pod
index 162272b..9f26473 100644 (file)
--- a/pod/perltie.pod
+++ b/pod/perltie.pod
@@ -952,6 +952,19 @@ This method will be called when the C<getc> function is called.
 
     sub GETC { print "Don't GETC, Get Perl"; return "a"; }
 
+=item EOF this
+X<EOF>
+
+This method will be called when the C<eof> function is called.
+
+Starting with Perl 5.12, an additional integer parameter will be passed.  It
+will be zero if C<eof> is called without parameter; C<1> if C<eof> is given
+a filehandle as a parameter, e.g. C<eof(FH)>; and C<2> in the very special
+case that the tied filehandle is C<ARGV> and C<eof> is called with an empty
+parameter list, e.g. C<eof()>.
+
+    sub EOF { not length $stringbuf }
+
 =item CLOSE this
 X<CLOSE>
 

diff --git a/pp_sys.c b/pp_sys.c
index f1015ad..ec49cbe 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2025,51 +2025,60 @@ PP(pp_eof)
 {
     dVAR; dSP;
     GV *gv;
+    IO *io;
+    MAGIC *mg;
 
-    if (MAXARG == 0) {
-       if (PL_op->op_flags & OPf_SPECIAL) {    /* eof() */
-           IO *io;
-           gv = PL_last_in_gv = GvEGV(PL_argvgv);
-           io = GvIO(gv);
-           if (io && !IoIFP(io)) {
-               if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
-                   IoLINES(io) = 0;
-                   IoFLAGS(io) &= ~IOf_START;
-                   do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
-                   if ( GvSV(gv) ) {
-                       sv_setpvs(GvSV(gv), "-");
-                   }
-                   else {
-                       GvSV(gv) = newSVpvs("-");
-                   }
-                   SvSETMAGIC(GvSV(gv));
-               }
-               else if (!nextargv(gv))
-                   RETPUSHYES;
-           }
-       }
+    if (MAXARG)
+       gv = PL_last_in_gv = MUTABLE_GV(POPs);  /* eof(FH) */
+    else if (PL_op->op_flags & OPf_SPECIAL)
+       gv = PL_last_in_gv = GvEGV(PL_argvgv);  /* eof() - ARGV magic */
+    else
+       gv = PL_last_in_gv;                     /* eof */
+
+    if (!gv)
+       RETPUSHNO;
+
+    if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
+       PUSHMARK(SP);
+       XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
+       /*
+        * in Perl 5.12 and later, the additional paramter is a bitmask:
+        * 0 = eof
+        * 1 = eof(FH)
+        * 2 = eof()  <- ARGV magic
+        */
+       if (MAXARG)
+           mPUSHi(1);          /* 1 = eof(FH) - simple, explicit FH */
+       else if (PL_op->op_flags & OPf_SPECIAL)
+           mPUSHi(2);          /* 2 = eof()   - ARGV magic */
        else
-           gv = PL_last_in_gv;                 /* eof */
+           mPUSHi(0);          /* 0 = eof     - simple, implicit FH */
+       PUTBACK;
+       ENTER;
+       call_method("EOF", G_SCALAR);
+       LEAVE;
+       SPAGAIN;
+       RETURN;
     }
-    else
-       gv = PL_last_in_gv = MUTABLE_GV(POPs);  /* eof(FH) */
 
-    if (gv) {
-       IO * const io = GvIO(gv);
-       MAGIC * mg;
-       if (io && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
-           PUSHMARK(SP);
-           XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-           PUTBACK;
-           ENTER;
-           call_method("EOF", G_SCALAR);
-           LEAVE;
-           SPAGAIN;
-           RETURN;
+    if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) {  /* eof() */
+       if (io && !IoIFP(io)) {
+           if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
+               IoLINES(io) = 0;
+               IoFLAGS(io) &= ~IOf_START;
+               do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
+               if (GvSV(gv))
+                   sv_setpvs(GvSV(gv), "-");
+               else
+                   GvSV(gv) = newSVpvs("-");
+               SvSETMAGIC(GvSV(gv));
+           }
+           else if (!nextargv(gv))
+               RETPUSHYES;
        }
     }
 
-    PUSHs(boolSV(!gv || do_eof(gv)));
+    PUSHs(boolSV(do_eof(gv)));
     RETURN;
 }
 

diff --git a/t/op/tiehandle.t b/t/op/tiehandle.t
index 735a25c..dbd0846 100755 (executable)
--- a/t/op/tiehandle.t
+++ b/t/op/tiehandle.t
@@ -10,7 +10,7 @@ my $data = "";
 my @data = ();
 
 require './test.pl';
-plan(tests => 50);
+plan(tests => 63);
 
 sub compare {
     local $Level = $Level + 1;
@@ -61,6 +61,11 @@ sub READ {
     3;
 }
 
+sub EOF {
+    ::compare(EOF => @_);
+    @data ? '' : 1;
+}
+
 sub WRITE {
     ::compare(WRITE => @_);
     $data = substr($_[1],$_[3] || 0, $_[2]);
@@ -69,7 +74,6 @@ sub WRITE {
 
 sub CLOSE {
     ::compare(CLOSE => @_);
-    
     5;
 }
 
@@ -92,11 +96,18 @@ is($r, 1);
 $r = printf $fh @expect[2,3];
 is($r, 2);
 
-$text = (@data = ("the line\n"))[0];
+@data = ("the line\n");
+@expect = (EOF => $ob, 1);
+is(eof($fh), '');
+
+$text = $data[0];
 @expect = (READLINE => $ob);
 $ln = <$fh>;
 is($ln, $text);
 
+@expect = (EOF => $ob, 0);
+is(eof, 1);
+
 @expect = ();
 @in = @data = qw(a line at a time);
 @line = <$fh>;
@@ -273,3 +284,22 @@ is($r, 1);
     sub READLINE { "foobar\n" }
 }
 
+{
+    # make sure the new eof() features work with @ARGV magic
+    local *ARGV;
+    @ARGV = ('haha');
+
+    @expect = (TIEHANDLE => 'Implement');
+    $ob = tie *ARGV, 'Implement';
+    is(ref($ob),  'Implement');
+    is(tied(*ARGV), $ob);
+
+    @data = ("stuff\n");
+    @expect = (EOF => $ob, 1);
+    is(eof(ARGV), '');
+    @expect = (EOF => $ob, 2);
+    is(eof(), '');
+    shift @data;
+    @expect = (EOF => $ob, 0);
+    is(eof, 1);
+}