else if (!type) {
o->op_private |= OPpLVAL_INTRO;
o->op_flags &= ~OPf_SPECIAL;
+ hints |= HINT_BLOCK_SCOPE;
}
else if (type != OP_GREPSTART && type != OP_ENTERSUB)
o->op_flags |= OPf_REF;
CV *cv = perl_get_cv("DB::postponed", FALSE);
if (cv) {
dSP;
- PUSHMARK(sp);
+ PUSHMARK(SP);
XPUSHs((SV*)compiling.cop_filegv);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
goto done;
}
/* ahem, death to those who redefine active sort subs */
- if (curstack == sortstack && sortcop == CvSTART(cv))
+ if (curstackinfo->si_type == SI_SORT && sortcop == CvSTART(cv))
croak("Can't redefine active sort subroutine %s", name);
const_sv = cv_const_sv(cv);
- if (const_sv || dowarn) {
+ if (const_sv || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
+ && HvNAME(GvSTASH(CvGV(cv)))
+ && strEQ(HvNAME(GvSTASH(CvGV(cv))),
+ "autouse"))) {
line_t oldline = curcop->cop_line;
curcop->cop_line = copline;
warn(const_sv ? "Constant subroutine %s redefined"
if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
&& (cv = GvCV(db_postponed))) {
dSP;
- PUSHMARK(sp);
+ PUSHMARK(SP);
XPUSHs(tmpstr);
PUTBACK;
perl_call_sv((SV*)cv, G_DISCARD);
return cv;
}
+void
+newCONSTSUB(HV *stash, char *name, SV *sv)
+{
+ dTHR;
+ U32 oldhints = hints;
+ HV *old_cop_stash = curcop->cop_stash;
+ HV *old_curstash = curstash;
+ line_t oldline = curcop->cop_line;
+ curcop->cop_line = copline;
+
+ hints &= ~HINT_BLOCK_SCOPE;
+ if(stash)
+ curstash = curcop->cop_stash = stash;
+
+ newSUB(
+ start_subparse(FALSE, 0),
+ newSVOP(OP_CONST, 0, newSVpv(name,0)),
+ newSVOP(OP_CONST, 0, &sv_no), /* SvPV(&sv_no) == "" -- GMB */
+ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
+ );
+
+ hints = oldhints;
+ curcop->cop_stash = old_cop_stash;
+ curstash = old_curstash;
+ curcop->cop_line = oldline;
+}
+
CV *
newXS(char *name, void (*subaddr) (CV *), char *filename)
{
}
else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
/* already defined (or promised) */
- if (dowarn) {
+ if (dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
+ && HvNAME(GvSTASH(CvGV(cv)))
+ && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
line_t oldline = curcop->cop_line;
curcop->cop_line = copline;
warn("Subroutine %s redefined",name);
if (o->op_flags & OPf_KIDS) {
OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
if (kid && kid->op_type == OP_CONST)
- fbm_compile(((SVOP*)kid)->op_sv);
+ fbm_compile(((SVOP*)kid)->op_sv, 0);
}
return ck_fun(o);
}