Convert Devel::Peek's test to Test::More.

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 05c5310..7d041bd 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -96,6 +96,7 @@ PP(pp_regcomp)
 
 #define tryAMAGICregexp(rx)                    \
     STMT_START {                               \
+       SvGETMAGIC(rx);                         \
        if (SvROK(rx) && SvAMAGIC(rx)) {        \
            SV *sv = AMG_CALLun(rx, regexp);    \
            if (sv) {                           \
@@ -324,7 +325,10 @@ PP(pp_substcont)
            SvPV_set(dstr, NULL);
 
            TAINT_IF(cx->sb_rxtainted & 1);
-           mPUSHi(saviters - 1);
+           if (pm->op_pmflags & PMf_NONDESTRUCT)
+               PUSHs(targ);
+           else
+               mPUSHi(saviters - 1);
 
            (void)SvPOK_only_UTF8(targ);
            TAINT_IF(cx->sb_rxtainted);
@@ -1631,8 +1635,8 @@ Perl_die_unwind(pTHX_ SV *msv)
                 * supposed to trap errors. So now that we've popped the
                 * EVAL that pp_require pushed, and processed the error
                 * message, rethrow the error */
-               DIE(aTHX_ "%sCompilation failed in require",
-                   *msg ? msg : "Unknown error\n");
+               Perl_croak(aTHX_ "%sCompilation failed in require",
+                          *msg ? msg : "Unknown error\n");
            }
            if (in_eval & EVAL_KEEPERR) {
                Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %s",
@@ -3464,11 +3468,6 @@ 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 = SvPV_nolen_const(*svp);
-
                    if (count > 0) {
                        int i = 0;
                        SV *arg;
@@ -3530,6 +3529,12 @@ PP(pp_require)
                    FREETMPS;
                    LEAVE_with_name("call_INC");
 
+                   /* Adjust file name if the hook has set an %INC entry.
+                      This needs to happen after the FREETMPS above.  */
+                   svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+                   if (svp)
+                       tryname = SvPV_nolen_const(*svp);
+
                    if (tryrsfp) {
                        hook_sv = dirsv;
                        break;
@@ -3622,39 +3627,39 @@ PP(pp_require)
            }
        }
     }
-    SAVECOPFILE_FREE(&PL_compiling);
-    CopFILE_set(&PL_compiling, tryrsfp ? tryname : name);
+    if (tryrsfp) {
+       SAVECOPFILE_FREE(&PL_compiling);
+       CopFILE_set(&PL_compiling, tryname);
+    }
     SvREFCNT_dec(namesv);
     if (!tryrsfp) {
        if (PL_op->op_type == OP_REQUIRE) {
-           const char *msgstr = name;
            if(errno == EMFILE) {
-               SV * const msg
-                   = sv_2mortal(Perl_newSVpvf(aTHX_ "%s:   %s", msgstr,
-                                              Strerror(errno)));
-               msgstr = SvPV_nolen_const(msg);
+               /* diag_listed_as: Can't locate %s */
+               DIE(aTHX_ "Can't locate %s:   %s", name, Strerror(errno));
            } else {
                if (namesv) {                   /* did we lookup @INC? */
                    AV * const ar = GvAVn(PL_incgv);
                    I32 i;
-                   SV * const msg = sv_2mortal(Perl_newSVpvf(aTHX_ 
-                       "%s in @INC%s%s (@INC contains:",
-                       msgstr,
-                       (instr(msgstr, ".h ")
-                        ? " (change .h to .ph maybe?)" : ""),
-                       (instr(msgstr, ".ph ")
-                        ? " (did you run h2ph?)" : "")
-                                                             ));
-                   
+                   SV *const inc = newSVpvs_flags("", SVs_TEMP);
                    for (i = 0; i <= AvFILL(ar); i++) {
-                       sv_catpvs(msg, " ");
-                       sv_catsv(msg, *av_fetch(ar, i, TRUE));
+                       sv_catpvs(inc, " ");
+                       sv_catsv(inc, *av_fetch(ar, i, TRUE));
                    }
-                   sv_catpvs(msg, ")");
-                   msgstr = SvPV_nolen_const(msg);
-               }    
+
+                   /* diag_listed_as: Can't locate %s */
+                   DIE(aTHX_
+                       "Can't locate %s in @INC%s%s (@INC contains:%" SVf ")",
+                       name,
+                       (memEQ(name + len - 2, ".h", 3)
+                        ? " (change .h to .ph maybe?) (did you run h2ph?)" : ""),
+                       (memEQ(name + len - 3, ".ph", 4)
+                        ? " (did you run h2ph?)" : ""),
+                       inc
+                       );
+               }
            }
-           DIE(aTHX_ "Can't locate %s", msgstr);
+           DIE(aTHX_ "Can't locate %s", name);
        }
 
        RETPUSHUNDEF;
@@ -4159,6 +4164,19 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
     SV *e = TOPs;      /* e is for 'expression' */
     SV *d = TOPm1s;    /* d is for 'default', as in PL_defgv */
 
+    /* Take care only to invoke mg_get() once for each argument.
+     * Currently we do this by copying the SV if it's magical. */
+    if (d) {
+       if (SvGMAGICAL(d))
+           d = sv_mortalcopy(d);
+    }
+    else
+       d = &PL_sv_undef;
+
+    assert(e);
+    if (SvGMAGICAL(e))
+       e = sv_mortalcopy(e);
+
     /* First of all, handle overload magic of the rightmost argument */
     if (SvAMAGIC(e)) {
        SV * tmpsv;
@@ -4177,18 +4195,6 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 
     SP -= 2;   /* Pop the values */
 
-    /* Take care only to invoke mg_get() once for each argument. 
-     * Currently we do this by copying the SV if it's magical. */
-    if (d) {
-       if (SvGMAGICAL(d))
-           d = sv_mortalcopy(d);
-    }
-    else
-       d = &PL_sv_undef;
-
-    assert(e);
-    if (SvGMAGICAL(e))
-       e = sv_mortalcopy(e);
 
     /* ~~ undef */
     if (!SvOK(e)) {