Stop eof($glob_copy) from clearing PL_last_in_gv

eof had the same bug as tell.  Here is the commit message from
8dc99089, which fixed tell:

----------------------------------------------------------------------

Stop tell($glob_copy) from clearing PL_last_in_gv

This bug is a side effect of rv2gv’s starting to return an incoercible
mortal copy of a coercible glob in 5.14:

$ perl5.12.4 -le 'open FH, "t/test.pl"; $fh=*FH; tell $fh; print tell'
0
$ perl5.14.0 -le 'open FH, "t/test.pl"; $fh=*FH; tell $fh; print tell'
-1

In the first case, tell without arguments is returning the position of
the filehandle.

In the second case, tell with an explicit argument that happens to
be a coercible glob (tell has an implicit rv2gv, so tell $fh is actu-
ally tell *$fh) sets PL_last_in_gv to a mortal copy thereof, which is
freed at the end of the statement, setting PL_last_in_gv to null.  So
there is no ‘last used’ handle by the time we get to the tell without
arguments.

This commit adds a new rv2gv flag that tells it not to copy the glob.

By doing it unconditionally on the kidop, this allows tell(*$fh) to
work the same way.

Let’s hope nobody does tell(*{*$fh}), which will unset PL_last_in_gv
because the inner * returns a mortal copy.

This whole area is really icky.  PL_last_in_gv should be refcounted,
but that would cause handles to leak out of scope, breaking programs
that rely on the auto-closing ‘feature’.

diff --git a/op.c b/op.c
index 8fc6ea8..ad06161 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7469,6 +7469,7 @@ Perl_ck_eof(pTHX_ OP *o)
     PERL_ARGS_ASSERT_CK_EOF;
 
     if (o->op_flags & OPf_KIDS) {
+       OP *kid;
        if (cLISTOPo->op_first->op_type == OP_STUB) {
            OP * const newop
                = newUNOP(o->op_type, OPf_SPECIAL, newGVOP(OP_GV, 0, PL_argvgv));
@@ -7479,7 +7480,10 @@ Perl_ck_eof(pTHX_ OP *o)
 #endif
            o = newop;
        }
-       return ck_fun(o);
+       o = ck_fun(o);
+       kid = cLISTOPo->op_first;
+       if (kid->op_type == OP_RV2GV)
+           kid->op_private |= OPpALLOW_FAKE;
     }
     return o;
 }

diff --git a/t/io/tell.t b/t/io/tell.t
index 5fe65b3..91fe317 100644 (file)
--- a/t/io/tell.t
+++ b/t/io/tell.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-print "1..31\n";
+print "1..33\n";
 
 $TST = 'TST';
 
@@ -169,3 +169,9 @@ print "${not}ok 30 - argless tell after tell \$coercible\n";
 tell *$fh;
 $not = "not " x! (tell == 0);
 print "${not}ok 31 - argless tell after tell *\$coercible\n";
+eof $fh;
+$not = "not " x! (tell == 0);
+print "${not}ok 32 - argless tell after eof \$coercible\n";
+eof *$fh;
+$not = "not " x! (tell == 0);
+print "${not}ok 33 - argless tell after eof *\$coercible\n";