do subname() is deprecated, so update this hunk of test dating from perl 1.

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

diff --git a/pp_ctl.c b/pp_ctl.c
index 4cde9f8..bbac702 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -233,13 +233,16 @@ PP(pp_substcont)
        if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
            cx->sb_rxtainted |= 2;
        sv_catsv(dstr, POPs);
+       /* XXX: adjust for positive offsets of \G for instance s/(.)\G//g with positive pos() */
+       s -= RX_GOFS(rx);
 
        /* Are we done */
-       if (CxONCE(cx) || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
-                                    s == m, cx->sb_targ, NULL,
-                                    ((cx->sb_rflags & REXEC_COPY_STR)
-                                     ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
-                                     : (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST))))
+       if (CxONCE(cx) || s < orig ||
+               !CALLREGEXEC(rx, s, cx->sb_strend, orig,
+                            (s == m) + RX_GOFS(rx), cx->sb_targ, NULL,
+                            ((cx->sb_rflags & REXEC_COPY_STR)
+                             ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
+                             : (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST))))
        {
            SV * const targ = cx->sb_targ;
 
@@ -532,8 +535,7 @@ PP(pp_formline)
                sv = *++MARK;
            else {
                sv = &PL_sv_no;
-               if (ckWARN(WARN_SYNTAX))
-                   Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments");
+               Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments");
            }
            break;
 
@@ -1280,9 +1282,8 @@ S_dopoptolabel(pTHX_ const char *label)
        case CXt_FORMAT:
        case CXt_EVAL:
        case CXt_NULL:
-           if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
-                       context_name[CxTYPE(cx)], OP_NAME(PL_op));
+           Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
+                          context_name[CxTYPE(cx)], OP_NAME(PL_op));
            if (CxTYPE(cx) == CXt_NULL)
                return -1;
            break;
@@ -1401,9 +1402,8 @@ S_dopoptoloop(pTHX_ I32 startingblock)
        case CXt_FORMAT:
        case CXt_EVAL:
        case CXt_NULL:
-           if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
-                       context_name[CxTYPE(cx)], OP_NAME(PL_op));
+           Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
+                          context_name[CxTYPE(cx)], OP_NAME(PL_op));
            if ((CxTYPE(cx)) == CXt_NULL)
                return -1;
            break;
@@ -1545,14 +1545,13 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
                        e = NULL;
                }
                if (!e) {
+                   STRLEN start;
                    SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
                    sv_catpvn(err, prefix, sizeof(prefix)-1);
                    sv_catpvn(err, message, msglen);
-                   if (ckWARN(WARN_MISC)) {
-                       const STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
-                       Perl_warner(aTHX_ packWARN(WARN_MISC), "%s",
-                               SvPVX_const(err)+start);
-                   }
+                   start = SvCUR(err)-msglen-sizeof(prefix)+1;
+                   Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "%s",
+                                  SvPVX_const(err)+start);
                }
            }
            else {