From 8818d4099a576554d990d17764107b1b1480bead Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sun, 27 Feb 2011 00:35:26 -0800
Subject: [perl #79442] A #line "F" in a string eval doesn't update *{"_<F"}
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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).
---
 toke.c | 28 +++++++++++++++++++++++-----
 1 file changed, 23 insertions(+), 5 deletions(-)

(limited to 'toke.c')

diff --git a/toke.c b/toke.c
index 380722aba9..e55b4b3703 100644
--- 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
-- 
cgit v1.2.1