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

Message-ID: <[email protected]>

p4raw-id: //depot/perl@35074

Author: Chip Salzenberg

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>
 

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;
 }
 

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);
+}