summaryrefslogtreecommitdiff
path: root/toke.c
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2011-02-27 00:35:26 -0800
committerFather Chrysostomos <sprout@cpan.org>2011-02-27 00:35:43 -0800
commit8818d4099a576554d990d17764107b1b1480bead (patch)
tree64a353765373e13a98ac86a0bbef26825fc6f603 /toke.c
parent4d919e5b5b77044f49e291c3d7df6a8cc423b9f5 (diff)
downloadperl-8818d4099a576554d990d17764107b1b1480bead.tar.gz
[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).
Diffstat (limited to 'toke.c')
-rw-r--r--toke.c28
1 files changed, 23 insertions, 5 deletions
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