Re: [PATCH] Add recursive regexes similar to PCRE

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 1a4ab2d..fbe455e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1876,7 +1876,7 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
     {
       const char * const desc
          = PL_op_desc[(rtype == OP_SUBST || rtype == OP_TRANS)
-            ? rtype : OP_MATCH];
+                      ? (int)rtype : OP_MATCH];
       const char * const sample = ((ltype == OP_RV2AV || ltype == OP_PADAV)
             ? "@array" : "%hash");
       Perl_warner(aTHX_ packWARN(WARN_MISC),
@@ -2258,6 +2258,8 @@ Perl_gen_constant_list(pTHX_ register OP *o)
     pp_pushmark();
     CALLRUNOPS(aTHX);
     PL_op = curop;
+    assert (!(curop->op_flags & OPf_SPECIAL));
+    assert(curop->op_type == OP_RANGE);
     pp_anonlist();
     PL_tmps_floor = oldtmps_floor;
 
@@ -3223,7 +3225,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
         if (DO_UTF8(pat))
            pm->op_pmdynflags |= PMdf_UTF8;
        /* FIXME - can we make this function take const char * args?  */
-       PM_SETRE(pm, CALLREGCOMP(aTHX_ (char*)p, (char*)p + plen, pm));
+       PM_SETRE(pm, CALLREGCOMP((char*)p, (char*)p + plen, pm));
        if (strEQ("\\s+", PM_GETRE(pm)->precomp))
            pm->op_pmflags |= PMf_WHITE;
 #ifdef PERL_MAD
@@ -4553,7 +4555,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
        loop = tmp;
     }
 #else
-    loop = PerlMemShared_realloc(loop, sizeof(LOOP));
+    loop = (LOOP*)PerlMemShared_realloc(loop, sizeof(LOOP));
 #endif
     loop->op_targ = padoff;
     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont, 0);
@@ -5681,15 +5683,13 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 OP *
 Perl_newANONLIST(pTHX_ OP *o)
 {
-    return newUNOP(OP_REFGEN, 0,
-       mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
+    return convert(OP_ANONLIST, OPf_SPECIAL, o);
 }
 
 OP *
 Perl_newANONHASH(pTHX_ OP *o)
 {
-    return newUNOP(OP_REFGEN, 0,
-       mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
+    return convert(OP_ANONHASH, OPf_SPECIAL, o);
 }
 
 OP *
@@ -7303,7 +7303,7 @@ Perl_ck_subr(pTHX_ OP *o)
     int optional = 0;
     I32 arg = 0;
     I32 contextclass = 0;
-    char *e = NULL;
+    const char *e = NULL;
     bool delete_op = 0;
 
     o->op_private |= OPpENTERSUB_HASTARG;
@@ -7326,13 +7326,20 @@ Perl_ck_subr(pTHX_ OP *o)
                    proto_end = proto + len;
                }
                if (CvASSERTION(cv)) {
-                   if (PL_hints & HINT_ASSERTING) {
+                   U32 asserthints = 0;
+                   HV *const hinthv = GvHV(PL_hintgv);
+                   if (hinthv) {
+                       SV **svp = hv_fetchs(hinthv, "assertions", FALSE);
+                       if (svp && *svp)
+                           asserthints = SvUV(*svp);
+                   }
+                   if (asserthints & HINT_ASSERTING) {
                        if (PERLDB_ASSERTION && PL_curstash != PL_debstash)
                            o->op_private |= OPpENTERSUB_DB;
                    }
                    else {
                        delete_op = 1;
-                       if (!(PL_hints & HINT_ASSERTIONSSEEN) && ckWARN(WARN_ASSERTIONS)) {
+                       if (!(asserthints & HINT_ASSERTIONSSEEN) && ckWARN(WARN_ASSERTIONS)) {
                            Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS),
                                        "Impossible to activate assertion call");
                        }