Stop recursion from losing lex fh names

sub r {
    r($_[0]-1) if $_[0];
    open my $fh, "/dev/null";
    print "$_[0] $$fh\n"
}
r(5);
__END__

Output:
0 *main::
1 *main::
2 *main::
3 *main::
4 *main::
5 *main::$fh

The largest number represents the outermost call.

The handle name was being allocated as a target (a scratch variable
used by various operators to return values).  Targets are not shared
between recursion levels.

This commit tells pad_alloc to treat it like a constant, so it
is shared.

diff --git a/op.c b/op.c
index fd8868f..44d2f20 100644 (file)
--- a/op.c
+++ b/op.c
@@ -8901,7 +8901,7 @@ Perl_ck_fun(pTHX_ OP *o)
                            }
                            if (name) {
                                SV *namesv;
-                               targ = pad_alloc(OP_RV2GV, SVs_PADTMP);
+                               targ = pad_alloc(OP_RV2GV, SVf_READONLY);
                                namesv = PAD_SVl(targ);
                                SvUPGRADE(namesv, SVt_PV);
                                if (want_dollar && *name != '$')

diff --git a/t/op/gv.t b/t/op/gv.t
index 806a68a..c01c5d2 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use warnings;
 
-plan( tests => 252 );
+plan( tests => 253 );
 
 # type coercion on assignment
 $foo = 'foo';
@@ -637,6 +637,20 @@ foreach my $type (qw(integer number string)) {
        "RT #65582/#96326 anon glob stringification");
 }
 
+# Another stringification bug: Test that recursion does not cause lexical
+# handles to lose their names.
+sub r {
+    my @output;
+    @output = r($_[0]-1) if $_[0];
+    open my $fh, "TEST";
+    push @output, $$fh;
+    close $fh;
+    @output;
+}
+is join(' ', r(4)),
+  '*main::$fh *main::$fh *main::$fh *main::$fh *main::$fh',
+  'recursion does not cause lex handles to lose their names';
+
 # [perl #71254] - Assigning a glob to a variable that has a current
 # match position. (We are testing that Perl_magic_setmglob respects globs'
 # special used of SvSCREAM.)