From c6fb3f6e3e5160581b78d87d4c62f42ef3cc0db5 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Tue, 17 Jan 2012 18:22:16 -0800 Subject: [PATCH] =?utf8?q?[perl=20#106726]=20Don=E2=80=99t=20crash=20on=20?= =?utf8?q?length(@arr)=20warning?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit The RT ticket blames this on 676a678ac, but it was actually commit 579333ee9e3. 676a678ac extended this problem to evals (and modules), but it already occurred in the main program. This crashes: ./miniperl -Ilib -we 'sub {length my @forecasts}' because it is trying to find the variable name for the warning in the CV returned by find_runcv, but this is a *compile-time* warning, so using find_runcv is just wrong. It ends up looking for the array in PL_main_cv’s pad, instead of PL_compcv. --- op.c | 3 ++- sv.c | 6 ++++-- t/op/length.t | 9 ++++++++- 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/op.c b/op.c index 12f0cbc..a1f5d25 100644 --- a/op.c +++ b/op.c @@ -9720,7 +9720,8 @@ Perl_ck_length(pTHX_ OP *o) case OP_PADHV: case OP_PADAV: name = varname( - NULL, hash ? '%' : '@', kid->op_targ, NULL, 0, 1 + (GV *)PL_compcv, hash ? '%' : '@', kid->op_targ, + NULL, 0, 1 ); break; case OP_RV2HV: diff --git a/sv.c b/sv.c index dff1607..d116996 100644 --- a/sv.c +++ b/sv.c @@ -13859,7 +13859,7 @@ Perl_varname(pTHX_ const GV *const gv, const char gvtype, PADOFFSET targ, { SV * const name = sv_newmortal(); - if (gv) { + if (gv && isGV(gv)) { char buffer[2]; buffer[0] = gvtype; buffer[1] = 0; @@ -13878,10 +13878,12 @@ Perl_varname(pTHX_ const GV *const gv, const char gvtype, PADOFFSET targ, } } else { - CV * const cv = find_runcv(NULL); + CV * const cv = gv ? (CV *)gv : find_runcv(NULL); SV *sv; AV *av; + assert(!cv || SvTYPE(cv) == SVt_PVCV); + if (!cv || !CvPADLIST(cv)) return NULL; av = MUTABLE_AV((*av_fetch(CvPADLIST(cv), 0, FALSE))); diff --git a/t/op/length.t b/t/op/length.t index 0288bec..55260d3 100644 --- a/t/op/length.t +++ b/t/op/length.t @@ -6,7 +6,7 @@ BEGIN { @INC = '../lib'; } -plan (tests => 37); +plan (tests => 38); print "not " unless length("") == 0; print "ok 1\n"; @@ -224,4 +224,11 @@ is($ul, undef, "Assigned length of overloaded undef with result in TARG"); print length undef; } +{ + local $SIG{__WARN__} = sub { + pass '[perl #106726] no crash with length @lexical warning' + }; + eval ' sub { length my @forecasts } '; +} + is($warnings, 0, "There were no other warnings"); -- 2.7.4