fix a test failing under -Dmad

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

diff --git a/pp_hot.c b/pp_hot.c
index 2ac969a..4038629 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -150,7 +150,7 @@ PP(pp_sassign)
                SV *const value = SvRV(cv);
 
                SvUPGRADE((SV *)gv, SVt_RV);
-               SvROK_on(gv);
+               SvPCS_IMPORTED_on(gv);
                SvRV_set(gv, value);
                SvREFCNT_inc_simple_void(value);
                SETs(right);
@@ -1397,7 +1397,7 @@ play_it_again:
             && !SvROK(TARG))   /* Cannot trust since INTUIT cannot guess ^ */
            goto yup;
     }
-    if (CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase, minmatch, TARG, (void*)gpos, r_flags))
+    if (CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase, minmatch, TARG, INT2PTR(void*, gpos), r_flags))
     {
        PL_curpm = pm;
        if (dynpm->op_pmflags & PMf_ONCE)
@@ -1447,14 +1447,14 @@ play_it_again:
                }
                if (rx->startp[0] != -1) {
                    mg->mg_len = rx->endp[0];
-                   if (rx->startp[0] + rx->gofs == rx->endp[0])
+                   if (rx->startp[0] + rx->gofs == (UV)rx->endp[0])
                        mg->mg_flags |= MGf_MINMATCH;
                    else
                        mg->mg_flags &= ~MGf_MINMATCH;
                }
            }
            had_zerolen = (rx->startp[0] != -1
-                          && rx->startp[0] + rx->gofs == rx->endp[0]);
+                          && rx->startp[0] + rx->gofs == (UV)rx->endp[0]);
            PUTBACK;                    /* EVAL blocks may use stack */
            r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
            goto play_it_again;
@@ -1481,7 +1481,7 @@ play_it_again:
            }
            if (rx->startp[0] != -1) {
                mg->mg_len = rx->endp[0];
-               if (rx->startp[0] + rx->gofs == rx->endp[0])
+               if (rx->startp[0] + rx->gofs == (UV)rx->endp[0])
                    mg->mg_flags |= MGf_MINMATCH;
                else
                    mg->mg_flags &= ~MGf_MINMATCH;
@@ -1650,6 +1650,8 @@ Perl_do_readline(pTHX)
   have_fp:
     if (gimme == G_SCALAR) {
        sv = TARG;
+       if (type == OP_RCATLINE && SvGMAGICAL(sv))
+           mg_get(sv);
        if (SvROK(sv)) {
            if (type == OP_RCATLINE)
                SvPV_force_nolen(sv);
@@ -2118,7 +2120,8 @@ PP(pp_subst)
        !is_cow &&
 #endif
        (SvREADONLY(TARG)
-       || ( (SvTYPE(TARG) == SVt_PVGV || SvTYPE(TARG) > SVt_PVLV)
+        || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
+              || SvTYPE(TARG) > SVt_PVLV)
             && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
        DIE(aTHX_ PL_no_modify);
     PUTBACK;
@@ -2680,45 +2683,6 @@ PP(pp_leavesublv)
     return cx->blk_sub.retop;
 }
 
-
-STATIC CV *
-S_get_db_sub(pTHX_ SV **svp, CV *cv)
-{
-    dVAR;
-    SV * const dbsv = GvSVn(PL_DBsub);
-
-    save_item(dbsv);
-    if (!PERLDB_SUB_NN) {
-       GV * const gv = CvGV(cv);
-
-       if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
-            || strEQ(GvNAME(gv), "END")
-            || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
-                !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) ))) {
-           /* Use GV from the stack as a fallback. */
-           /* GV is potentially non-unique, or contain different CV. */
-           SV * const tmp = newRV((SV*)cv);
-           sv_setsv(dbsv, tmp);
-           SvREFCNT_dec(tmp);
-       }
-       else {
-           gv_efullname3(dbsv, gv, NULL);
-       }
-    }
-    else {
-       const int type = SvTYPE(dbsv);
-       if (type < SVt_PVIV && type != SVt_IV)
-           sv_upgrade(dbsv, SVt_PVIV);
-       (void)SvIOK_on(dbsv);
-       SvIV_set(dbsv, PTR2IV(cv));     /* Do it the quickest way  */
-    }
-
-    if (CvISXSUB(cv))
-       PL_curcopdb = PL_curcop;
-    cv = GvCV(PL_DBsub);
-    return cv;
-}
-
 PP(pp_entersub)
 {
     dVAR; dSP; dPOPss;
@@ -2826,7 +2790,11 @@ try_autoload:
         if (CvASSERTION(cv) && PL_DBassertion)
            sv_setiv(PL_DBassertion, 1);
        
-       cv = get_db_sub(&sv, cv);
+        Perl_get_db_sub(aTHX_ &sv, cv);
+        if (CvISXSUB(cv))
+            PL_curcopdb = PL_curcop;
+        cv = GvCV(PL_DBsub);
+
        if (!cv || (!CvXSUB(cv) && !CvSTART(cv)))
            DIE(aTHX_ "No DB::sub routine defined");
     }