perldiag.pod: Fix wrong Perl versions

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 0256070..bdbd75a 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -83,7 +83,7 @@ PP(pp_regcomp)
     REGEXP *re = NULL;
     REGEXP *new_re;
     const regexp_engine *eng;
-    bool is_bare_re;
+    bool is_bare_re= FALSE;
 
     if (PL_op->op_flags & OPf_STACKED) {
        dMARK;
@@ -107,14 +107,27 @@ PP(pp_regcomp)
     assert (re != (REGEXP*) &PL_sv_undef);
     eng = re ? RX_ENGINE(re) : current_re_engine();
 
+    /*
+     In the below logic: these are basically the same - check if this regcomp is part of a split.
+
+    (PL_op->op_pmflags & PMf_split )
+    (PL_op->op_next->op_type == OP_PUSHRE)
+
+    We could add a new mask for this and copy the PMf_split, if we did
+    some bit definition fiddling first.
+
+    For now we leave this
+    */
+
     new_re = (eng->op_comp
                    ? eng->op_comp
                    : &Perl_re_op_compile
            )(aTHX_ args, nargs, pm->op_code_list, eng, re,
                &is_bare_re,
-               (pm->op_pmflags & RXf_PMf_COMPILETIME),
+                (pm->op_pmflags & RXf_PMf_FLAGCOPYMASK),
                pm->op_pmflags |
                    (PL_op->op_flags & OPf_SPECIAL ? PMf_USE_RE_EVAL : 0));
+
     if (pm->op_pmflags & PMf_HAS_CV)
        ReANY(new_re)->qr_anoncv
                        = (CV*) SvREFCNT_inc(PAD_SV(PL_op->op_targ));
@@ -145,11 +158,13 @@ PP(pp_regcomp)
        ReREFCNT_dec(new_re);
        new_re = tmp;
     }
+
     if (re != new_re) {
        ReREFCNT_dec(re);
        PM_SETRE(pm, new_re);
     }
 
+
 #ifndef INCOMPLETE_TAINTS
     if (TAINTING_get && TAINT_get) {
        SvTAINTED_on((SV*)new_re);
@@ -2692,7 +2707,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
 {
     dVAR;
     OP **ops = opstack;
-    static const char too_deep[] = "Target of goto is too deeply nested";
+    static const char* const too_deep = "Target of goto is too deeply nested";
 
     PERL_ARGS_ASSERT_DOFINDLABEL;
 
@@ -2764,7 +2779,7 @@ PP(pp_goto)
     STRLEN label_len = 0;
     U32 label_flags = 0;
     const bool do_dump = (PL_op->op_type == OP_DUMP);
-    static const char must_have_label[] = "goto must have label";
+    static const char* const must_have_label = "goto must have label";
 
     if (PL_op->op_flags & OPf_STACKED) {
        SV * const sv = POPs;
@@ -2803,13 +2818,13 @@ PP(pp_goto)
            SvREFCNT_inc_simple_void(cv); /* avoid premature free during unwind */
            FREETMPS;
            cxix = dopoptosub(cxstack_ix);
-           if (cxix < 0)
-           {
-               SvREFCNT_dec(cv);
-               DIE(aTHX_ "Can't goto subroutine outside a subroutine");
-           }
-           if (cxix < cxstack_ix)
+           if (cxix < cxstack_ix) {
+                if (cxix < 0) {
+                    SvREFCNT_dec(cv);
+                    DIE(aTHX_ "Can't goto subroutine outside a subroutine");
+                }
                dounwind(cxix);
+            }
            TOPBLOCK(cx);
            SPAGAIN;
            /* ban goto in eval: see <20050521150056.GC20213@iabyn.com> */
@@ -2867,11 +2882,14 @@ PP(pp_goto)
            SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
            if (CvISXSUB(cv)) {
                OP* const retop = cx->blk_sub.retop;
-               SV **newsp PERL_UNUSED_DECL;
-               I32 gimme PERL_UNUSED_DECL;
+               SV **newsp;
+               I32 gimme;
                const SSize_t items = AvFILLp(arg) + 1;
                SV** mark;
 
+                PERL_UNUSED_VAR(newsp);
+                PERL_UNUSED_VAR(gimme);
+
                /* put GvAV(defgv) back onto stack */
                EXTEND(SP, items+1); /* @_ could have been extended. */
                Copy(AvARRAY(arg), SP + 1, items, SV*);
@@ -3340,7 +3358,9 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
 
     PL_in_eval = (in_require
                  ? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL))
-                 : EVAL_INEVAL);
+                 : (EVAL_INEVAL |
+                        ((PL_op->op_private & OPpEVAL_RE_REPARSING)
+                            ? EVAL_RE_REPARSING : 0)));
 
     PUSHMARK(SP);
 
@@ -3402,6 +3422,15 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
     else {
        PL_hints = saveop->op_private & OPpEVAL_COPHH
                     ? oldcurcop->cop_hints : saveop->op_targ;
+
+        /* making 'use re eval' not be in scope when compiling the
+         * qr/mabye_has_runtime_code_block/ ensures that we don't get
+         * infinite recursion when S_has_runtime_code() gives a false
+         * positive: the second time round, HINT_RE_EVAL isn't set so we
+         * don't bother calling S_has_runtime_code() */
+        if (PL_in_eval & EVAL_RE_REPARSING)
+            PL_hints &= ~HINT_RE_EVAL;
+
        if (hh) {
            /* SAVEHINTS created a new HV in PL_hintgv, which we need to GC */
            SvREFCNT_dec(GvHV(PL_hintgv));
@@ -3886,7 +3915,12 @@ PP(pp_require)
 
                        memcpy(tmp, dir, dirlen);
                        tmp +=dirlen;
-                       *tmp++ = '/';
+
+                       /* Avoid '<dir>//<file>' */
+                       if (!dirlen || *(tmp-1) != '/') {
+                           *tmp++ = '/';
+                       }
+
                        /* name came from an SV, so it will have a '\0' at the
                           end that we can copy as part of this memcpy().  */
                        memcpy(tmp, name, len + 1);
@@ -3902,7 +3936,7 @@ PP(pp_require)
                    if (tryrsfp) {
                        if (tryname[0] == '.' && tryname[1] == '/') {
                            ++tryname;
-                           while (*++tryname == '/');
+                           while (*++tryname == '/') {}
                        }
                        break;
                    }