Tweaks to the debugger test by Richard Foley,

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 832f189..5cbf0a8 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -131,10 +131,18 @@ PP(pp_regcomp)
        if (!re || !re->precomp || re->prelen != (I32)len ||
            memNE(re->precomp, t, len))
        {
+           const regexp_engine *eng = re ? re->engine : NULL;
+
            if (re) {
                ReREFCNT_dec(re);
                PM_SETRE(pm, NULL);     /* crucial if regcomp aborts */
+           } else if (PL_curcop->cop_hints_hash) {
+               SV *ptr = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, 0,
+                                      "regcomp", 7, 0, 0);
+                if (ptr && SvIOK(ptr) && SvIV(ptr))
+                    eng = INT2PTR(regexp_engine*,SvIV(ptr));
            }
+
            if (PL_op->op_flags & OPf_SPECIAL)
                PL_reginterp_cnt = I32_MAX; /* Mark as safe.  */
 
@@ -146,7 +154,11 @@ PP(pp_regcomp)
                if (pm->op_pmdynflags & PMdf_UTF8)
                    t = (char*)bytes_to_utf8((U8*)t, &len);
            }
-           PM_SETRE(pm, CALLREGCOMP(aTHX_ (char *)t, (char *)t + len, pm));
+           if (eng) 
+               PM_SETRE(pm, CALLREGCOMP_ENG(eng,(char *)t, (char *)t + len, pm));
+            else
+                PM_SETRE(pm, CALLREGCOMP((char *)t, (char *)t + len, pm));
+                
            if (!DO_UTF8(tmpstr) && (pm->op_pmdynflags & PMdf_UTF8))
                Safefree(t);
            PL_reginterp_cnt = 0;       /* XXXX Be extra paranoid - needed
@@ -214,7 +226,7 @@ PP(pp_substcont)
        FREETMPS; /* Prevent excess tmp stack */
 
        /* Are we done */
-       if (cx->sb_once || !CALLREGEXEC(aTHX_ rx, s, cx->sb_strend, orig,
+       if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
                                     s == m, cx->sb_targ, NULL,
                                     ((cx->sb_rflags & REXEC_COPY_STR)
                                      ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
@@ -283,7 +295,7 @@ PP(pp_substcont)
            SvUPGRADE(sv, SVt_PVMG);
        if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
 #ifdef PERL_OLD_COPY_ON_WRITE
-           if (SvIsCOW(lsv))
+           if (SvIsCOW(sv))
                sv_force_normal_flags(sv, 0);
 #endif
            mg = sv_magicext(sv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
@@ -1289,8 +1301,8 @@ Perl_is_lvalue_sub(pTHX)
     const I32 cxix = dopoptosub(cxstack_ix);
     assert(cxix >= 0);  /* We should only be called from inside subs */
 
-    if (CX_SUB_LVAL(cxstack + cxix) && CvLVALUE(cxstack[cxix].blk_sub.cv))
-       return CX_SUB_LVAL(cxstack + cxix);
+    if (cxstack[cxix].blk_sub.lval && CvLVALUE(cxstack[cxix].blk_sub.cv))
+       return cxstack[cxix].blk_sub.lval;
     else
        return 0;
 }
@@ -1641,11 +1653,11 @@ PP(pp_caller)
            SV * const sv = newSV(0);
            gv_efullname3(sv, cvgv, NULL);
            PUSHs(sv_2mortal(sv));
-           PUSHs(sv_2mortal(newSViv((I32)CX_SUB_HASARGS_GET(cx))));
+           PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
        }
        else {
            PUSHs(sv_2mortal(newSVpvs("(unknown)")));
-           PUSHs(sv_2mortal(newSViv((I32)CX_SUB_HASARGS_GET(cx))));
+           PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
        }
     }
     else {
@@ -1678,7 +1690,7 @@ PP(pp_caller)
        PUSHs(&PL_sv_undef);
        PUSHs(&PL_sv_undef);
     }
-    if (CxTYPE(cx) == CXt_SUB && CX_SUB_HASARGS_GET(cx)
+    if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs
        && CopSTASH_eq(PL_curcop, PL_debstash))
     {
        AV * const ary = cx->blk_sub.argarray;
@@ -2113,7 +2125,7 @@ PP(pp_last)
     case CXt_LOOP:
        pop2 = CXt_LOOP;
        newsp = PL_stack_base + cx->blk_loop.resetsp;
-       nextop = cx->blk_loop.last_op->op_next;
+       nextop = cx->blk_loop.my_op->op_lastop->op_next;
        break;
     case CXt_SUB:
        pop2 = CXt_SUB;
@@ -2196,7 +2208,7 @@ PP(pp_next)
     if (PL_scopestack_ix < inner)
        leave_scope(PL_scopestack[PL_scopestack_ix]);
     PL_curcop = cx->blk_oldcop;
-    return cx->blk_loop.next_op;
+    return CX_LOOP_NEXTOP_GET(cx);
 }
 
 PP(pp_redo)
@@ -2220,7 +2232,7 @@ PP(pp_redo)
     if (cxix < cxstack_ix)
        dounwind(cxix);
 
-    redo_op = cxstack[cxix].blk_loop.redo_op;
+    redo_op = cxstack[cxix].blk_loop.my_op->op_redoop;
     if (redo_op->op_type == OP_ENTER) {
        /* pop one less context to avoid $x being freed in while (my $x..) */
        cxstack_ix++;
@@ -2348,7 +2360,7 @@ PP(pp_goto)
            }
            else if (CxMULTICALL(cx))
                DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)");
-           if (CxTYPE(cx) == CXt_SUB && CX_SUB_HASARGS_GET(cx)) {
+           if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
                /* put @_ back onto stack */
                AV* av = cx->blk_sub.argarray;
 
@@ -2410,7 +2422,7 @@ PP(pp_goto)
                    PL_in_eval = cx->blk_eval.old_in_eval;
                    PL_eval_root = cx->blk_eval.old_eval_root;
                    cx->cx_type = CXt_SUB;
-                   CX_SUB_HASARGS_SET(cx, 0);
+                   cx->blk_sub.hasargs = 0;
                }
                cx->blk_sub.cv = cv;
                cx->blk_sub.olddepth = CvDEPTH(cv);
@@ -2425,7 +2437,7 @@ PP(pp_goto)
                }
                SAVECOMPPAD();
                PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
-               if (CX_SUB_HASARGS_GET(cx))
+               if (cx->blk_sub.hasargs)
                {
                    AV* const av = (AV*)PAD_SVl(0);
 
@@ -2438,13 +2450,13 @@ PP(pp_goto)
                        SV **ary = AvALLOC(av);
                        if (AvARRAY(av) != ary) {
                            AvMAX(av) += AvARRAY(av) - AvALLOC(av);
-                           SvPV_set(av, (char*)ary);
+                           AvARRAY(av) = ary;
                        }
                        if (items >= AvMAX(av) + 1) {
                            AvMAX(av) = items - 1;
                            Renew(ary,items+1,SV*);
                            AvALLOC(av) = ary;
-                           SvPV_set(av, (char*)ary);
+                           AvARRAY(av) = ary;
                        }
                    }
                    ++mark;
@@ -2914,9 +2926,13 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
        SAVESPTR(PL_curstash);
        PL_curstash = CopSTASH(PL_curcop);
     }
+    /* XXX:ajgo do we really need to alloc an AV for begin/checkunit */
     SAVESPTR(PL_beginav);
     PL_beginav = newAV();
     SAVEFREESV(PL_beginav);
+    SAVESPTR(PL_unitcheckav);
+    PL_unitcheckav = newAV();
+    SAVEFREESV(PL_unitcheckav);
     SAVEI32(PL_error_count);
 
 #ifdef PERL_MAD
@@ -3010,6 +3026,9 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
        }
     }
 
+    if (PL_unitcheckav)
+       call_list(PL_scopestack_ix, PL_unitcheckav);
+
     /* compiled okay, so do it */
 
     CvDEPTH(PL_compcv) = 1;
@@ -3147,6 +3166,7 @@ PP(pp_require)
 
                if (SvROK(dirsv)) {
                    int count;
+                   SV **svp;
                    SV *loader = dirsv;
 
                    if (SvTYPE(SvRV(loader)) == SVt_PVAV
@@ -3174,6 +3194,11 @@ PP(pp_require)
                        count = call_sv(loader, G_ARRAY);
                    SPAGAIN;
 
+                   /* Adjust file name if the hook has set an %INC entry */
+                   svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+                   if (svp)
+                       tryname = SvPVX_const(*svp);
+
                    if (count > 0) {
                        int i = 0;
                        SV *arg;
@@ -3436,8 +3461,6 @@ PP(pp_entereval)
     }
     sv = POPs;
 
-    if (!SvPV_nolen_const(sv))
-       RETPUSHUNDEF;
     TAINT_PROPER("eval");
 
     ENTER;
@@ -4245,7 +4268,7 @@ PP(pp_break)
     PL_curcop = cx->blk_oldcop;
 
     if (CxFOREACH(cx))
-       return cx->blk_loop.next_op;
+       return CX_LOOP_NEXTOP_GET(cx);
     else
        return cx->blk_givwhen.leave_op;
 }