In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/a92039c3eeab8e70aea3bee8729202a4b052282c?hp=feff7485ae0da6a0fe00f976c4294583b5c11dc9>
- Log -----------------------------------------------------------------
commit a92039c3eeab8e70aea3bee8729202a4b052282c
Merge: feff748 4428fb0
Author: Tony Cook <t...@develop-help.com>
Date: Fri Apr 26 11:57:36 2013 +1000
[perl #117607] don't crash on: use strict; $foo; &CORE::lc
commit 4428fb0e76f4c3da6fd94b4c775dc81228b417d6
Author: Tony Cook <t...@develop-help.com>
Date: Thu Apr 25 18:27:09 2013 +1000
[perl #117607] don't use a CV after it's been freed
M gv.c
M t/op/coresubs.t
commit 83d52ea4d1c8dd691ed020eab0642880164a91fe
Author: Tony Cook <t...@develop-help.com>
Date: Thu Apr 25 18:10:10 2013 +1000
[perl #117607] TODO test for \&CORE::lc in error context
The original sample was:
BEGIN {
$^H |= 0x00000400; # strict vars
}
# Undeclared variable here
sub foo { return $anyvar; }
# Any CORE:: here
sub bar { \&CORE::lc }
simplified to:
BEGIN {
$^H |= 0x00000400; # strict vars
}
$anyvar;
&CORE::lc;
but it occurs for any compile-time error that doesn't abort compilation,
such as:
$foo/; \&CORE::lc
M t/op/coresubs.t
-----------------------------------------------------------------------
Summary of changes:
gv.c | 32 ++++++++++++++++++++------------
t/op/coresubs.t | 6 ++++++
2 files changed, 26 insertions(+), 12 deletions(-)
diff --git a/gv.c b/gv.c
index d96bde8..52291d4 100644
--- a/gv.c
+++ b/gv.c
@@ -450,7 +450,6 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
static const char file[] = __FILE__;
CV *cv, *oldcompcv = NULL;
int opnum = 0;
- SV *opnumsv;
bool ampable = TRUE; /* &{}-able */
COP *oldcurcop = NULL;
yy_parser *oldparser = NULL;
@@ -536,8 +535,13 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
if (stash)
(void)hv_store(stash,name,len,(SV *)gv,0);
if (ampable) {
+#ifdef DEBUGGING
+ CV *orig_cv = cv;
+#endif
CvLVALUE_on(cv);
- newATTRSUB_flags(
+ /* newATTRSUB will free the CV and return NULL if we're still
+ compiling after a syntax error */
+ if ((cv = newATTRSUB_flags(
oldsavestack_ix, (OP *)gv,
NULL,NULL,
coresub_op(
@@ -547,21 +551,25 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
code, opnum
),
1
- );
- assert(GvCV(gv) == cv);
- if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS
- && opnum != OP_UNDEF)
- CvLVALUE_off(cv); /* Now *that* was a neat trick. */
+ )) != NULL) {
+ assert(GvCV(gv) == orig_cv);
+ if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS
+ && opnum != OP_UNDEF)
+ CvLVALUE_off(cv); /* Now *that* was a neat trick. */
+ }
LEAVE;
PL_parser = oldparser;
PL_curcop = oldcurcop;
PL_compcv = oldcompcv;
}
- opnumsv = opnum ? newSVuv((UV)opnum) : (SV *)NULL;
- cv_set_call_checker(
- cv, Perl_ck_entersub_args_core, opnumsv ? opnumsv : (SV *)cv
- );
- SvREFCNT_dec(opnumsv);
+ if (cv) {
+ SV *opnumsv = opnum ? newSVuv((UV)opnum) : (SV *)NULL;
+ cv_set_call_checker(
+ cv, Perl_ck_entersub_args_core, opnumsv ? opnumsv : (SV *)cv
+ );
+ SvREFCNT_dec(opnumsv);
+ }
+
return gv;
}
diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index 1909c03..86118bc 100644
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -135,6 +135,12 @@ is runperl(prog => 'print CORE->lc, qq-\n-'), "core\n",
is runperl(prog => '@ISA=CORE; print main->uc, qq-\n-'), "MAIN\n",
'inherted method calls autovivify coresubs';
+{ # RT #117607
+ $tests++;
+ like runperl(prog => '$foo/; \&CORE::lc', stderr => 1),
+ qr/^syntax error/, "RT #117607: \\&CORE::foo doesn't crash in error
context";
+}
+
$tests++;
ok eval { *CORE::exit = \42 },
'[rt.cpan.org #74289] *CORE::foo is not accidentally made read-only';
--
Perl5 Master Repository
