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;
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(
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;
}
require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
else if (*name == '-' || *name == '+')
require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
- } else if (sv_type == SVt_PV && *name == '#') {
- Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED,
- WARN_SYNTAX),
- "$# is no longer supported");
- }
- if (*name == '*') {
- if (sv_type == SVt_PV)
+ } else if (sv_type == SVt_PV) {
+ if (*name == '*' || *name == '#') {
+ /* diag_listed_as: $* is no longer supported */
Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED,
WARN_SYNTAX),
- "$* is no longer supported, and will become a syntax error");
- else
- Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "%c* is deprecated, and will become a syntax error",
- sv_type == SVt_PVAV ? '@'
- : sv_type == SVt_PVCV ? '&'
- : sv_type == SVt_PVHV ? '%'
- : '*');
+ "$%c is no longer supported", *name);
+ }
}
if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
switch (*name) {
break;
}
case '*': /* $* */
- if (sv_type == SVt_PV)
- Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "$* is no longer supported, and will become a syntax error");
- else {
- Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "%c* is deprecated, and will become a syntax error",
- sv_type == SVt_PVAV ? '@'
- : sv_type == SVt_PVCV ? '&'
- : sv_type == SVt_PVHV ? '%'
- : '*');
- }
- break;
case '#': /* $# */
if (sv_type == SVt_PV)
+ /* diag_listed_as: $* is no longer supported */
Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
- "$# is no longer supported");
+ "$%c is no longer supported", *name);
break;
case '\010': /* $^H */
{