Changes to allow compiler with gcc-2.8.1 in C++ mode,

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index e30e874..73bd676 100644 (file)
--- a/op.c
+++ b/op.c
@@ -87,6 +87,7 @@ assertref(OP *o)
     if (type != OP_AELEM && type != OP_HELEM) {
        yyerror(form("Can't use subscript on %s", op_desc[type]));
        if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV) {
+           dTHR;
            SV *msg = sv_2mortal(
                        newSVpvf("(Did you mean $ or @ instead of %c?)\n",
                                 type == OP_ENTERSUB ? '&' : '%'));
@@ -1240,6 +1241,7 @@ mod(OP *o, I32 type)
     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;
@@ -1572,7 +1574,7 @@ newPROG(OP *o)
            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);
@@ -3329,10 +3331,13 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
                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"
@@ -3462,7 +3467,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
            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);
@@ -3512,6 +3517,33 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
     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)
 {
@@ -3527,7 +3559,9 @@ 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);
@@ -4256,7 +4290,7 @@ ck_index(OP *o)
     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);
 }