[perl #79442] A #line "F" in a string eval doesn't update *{"_<F"}

There are two problems here.

String evals do not populate @{"_<..."} arrays the way parsed streams
do. The lines are all put into the array before the parse. Commit
e66cf94 added the code to copy (actually alias, but whatever) the
lines into the new array when a #line directive is encountered. Inte-
restingly, the following commit (8a5ee59) wrapped that code in an
#ifndef USE_ITHREADS block, because ‘[c]hange 25409 [e66cf94] wasn’t
necessary for threaded perls’. It seems it *was* necessary for
threaded perls after all, because the lines are simply not copied.

In non-threaded perls it wasn’t working properly either. The array
in the new glob was the same array as the old (aliased), so the line
numbers would be off if the #line directive contained a line number
that differed.

This commit does three things:
• It removes the #ifndef,
• It checks whether the line number has changed and aliases the indi-
  vidual elements of the array.
• The breakpoints hash is not copied if the line number differs, as
  setting a breakpoint on (eval 1):1 (warn 1) in
    eval qq{warn 1;\n#line 1 "foo"\nwarn 2;}
  should not also set a breakpoint on foo:1 (warn 2).

diff --git a/t/comp/retainedlines.t b/t/comp/retainedlines.t
index 9a2a192..240c5b1 100644 (file)
--- a/t/comp/retainedlines.t
+++ b/t/comp/retainedlines.t
@@ -6,7 +6,7 @@
 # we've not yet verified that use works.
 # use strict;
 
-print "1..72\n";
+print "1..73\n";
 my $test = 0;
 
 sub failed {
@@ -148,3 +148,13 @@ for (0xA, 0) {
        "evals with BEGIN{die} are correctly cleaned up");
   }
 }
+
+# [perl #79442] A #line "foo" directive in a string eval was not updating
+# *{"_<foo"} in threaded perls, and was not putting the right lines into
+# the right elements of @{"_<foo"} in non-threaded perls.
+{
+  local $^P = 0x400|0x100|0x10;
+  eval qq{#line 42 "hash-line-eval"\n labadalabada()\n};
+  is $::{"_<hash-line-eval"}[42], " labadalabada()\n",
+   '#line 42 "foo" in a string eval updates @{"_<foo"}';
+}

diff --git a/toke.c b/toke.c
index 380722a..e55b4b3 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1511,6 +1511,7 @@ S_incline(pTHX_ const char *s)
     const char *t;
     const char *n;
     const char *e;
+    line_t line_num;
 
     PERL_ARGS_ASSERT_INCLINE;
 
@@ -1554,9 +1555,10 @@ S_incline(pTHX_ const char *s)
     if (*e != '\n' && *e != '\0')
        return;         /* false alarm */
 
+    line_num = atoi(n)-1;
+
     if (t - s > 0) {
        const STRLEN len = t - s;
-#ifndef USE_ITHREADS
        SV *const temp_sv = CopFILESV(PL_curcop);
        const char *cf;
        STRLEN tmplen;
@@ -1611,19 +1613,35 @@ S_incline(pTHX_ const char *s)
                    gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE);
                    /* adjust ${"::_<newfilename"} to store the new file name */
                    GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
-                   GvHV(gv2) = MUTABLE_HV(SvREFCNT_inc(GvHV(*gvp)));
-                   GvAV(gv2) = MUTABLE_AV(SvREFCNT_inc(GvAV(*gvp)));
+                   /* The line number may differ. If that is the case,
+                      alias the saved lines that are in the array.
+                      Otherwise alias the whole array. */
+                   if (CopLINE(PL_curcop) == line_num) {
+                       GvHV(gv2) = MUTABLE_HV(SvREFCNT_inc(GvHV(*gvp)));
+                       GvAV(gv2) = MUTABLE_AV(SvREFCNT_inc(GvAV(*gvp)));
+                   }
+                   else if (GvAV(*gvp)) {
+                       AV * const av = GvAV(*gvp);
+                       const I32 start = CopLINE(PL_curcop)+1;
+                       I32 items = AvFILLp(av) - start;
+                       if (items > 0) {
+                           AV * const av2 = GvAVn(gv2);
+                           SV **svp = AvARRAY(av) + start;
+                           I32 l = (I32)line_num+1;
+                           while (items--)
+                               av_store(av2, l++, SvREFCNT_inc(*svp++));
+                       }
+                   }
                }
 
                if (tmpbuf2 != smallbuf) Safefree(tmpbuf2);
            }
            if (tmpbuf != smallbuf) Safefree(tmpbuf);
        }
-#endif
        CopFILE_free(PL_curcop);
        CopFILE_setn(PL_curcop, s, len);
     }
-    CopLINE_set(PL_curcop, atoi(n)-1);
+    CopLINE_set(PL_curcop, line_num);
 }
 
 #ifdef PERL_MAD