move RXf_NOSCAN from extflags to intflags as PREGf_NOSCAN
authorYves Orton <yves.orton@booking.com>
Thu, 30 Jan 2014 06:02:44 +0000 (14:02 +0800)
committerYves Orton <yves.orton@booking.com>
Thu, 30 Jan 2014 17:45:34 +0000 (01:45 +0800)
Includes some improvements to how we dump regexps so that when a regexp
is for the standard perl engine we also show the intflags for the engine

dump.c
ext/Devel-Peek/t/Peek.t
regcomp.c
regcomp.h
regexp.h

diff --git a/dump.c b/dump.c
index 964f2fe..9c2f5fc 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -708,7 +708,7 @@ S_pm_description(pTHX_ const PMOP *pm)
         if (RX_ISTAINTED(regex))
             sv_catpv(desc, ",TAINTED");
         if (RX_CHECK_SUBSTR(regex)) {
-            if (!(RX_EXTFLAGS(regex) & RXf_NOSCAN))
+            if (!(RX_INTFLAGS(regex) & PREGf_NOSCAN))
                 sv_catpv(desc, ",SCANFIRST");
             if (RX_EXTFLAGS(regex) & RXf_CHECK_ALL)
                 sv_catpv(desc, ",ALL");
@@ -1542,7 +1542,7 @@ const struct flag_to_name gp_flags_imported_names[] = {
     {GVf_IMPORTED_CV, " CV"},
 };
 
-const struct flag_to_name regexp_flags_names[] = {
+const struct flag_to_name regexp_extflags_names[] = {
     {RXf_PMf_MULTILINE,   "PMf_MULTILINE,"},
     {RXf_PMf_SINGLELINE,  "PMf_SINGLELINE,"},
     {RXf_PMf_FOLD,        "PMf_FOLD,"},
@@ -1557,7 +1557,6 @@ const struct flag_to_name regexp_flags_names[] = {
     {RXf_NO_INPLACE_SUBST, "NO_INPLACE_SUBST,"},
     {RXf_EVAL_SEEN,       "EVAL_SEEN,"},
     {RXf_CANY_SEEN,       "CANY_SEEN,"},
-    {RXf_NOSCAN,          "NOSCAN,"},
     {RXf_CHECK_ALL,       "CHECK_ALL,"},
     {RXf_MATCH_UTF8,      "MATCH_UTF8,"},
     {RXf_USE_INTUIT_NOML, "USE_INTUIT_NOML,"},
@@ -1573,6 +1572,16 @@ const struct flag_to_name regexp_flags_names[] = {
     {RXf_NULL,            "NULL,"},
 };
 
+const struct flag_to_name regexp_core_intflags_names[] = {
+    {PREGf_SKIP,            "SKIP,"},
+    {PREGf_IMPLICIT,            "IMPLICIT,"},
+    {PREGf_NAUGHTY,            "NAUGHTY,"},
+    {PREGf_VERBARG_SEEN,    "VERBARG_SEEN,"},
+    {PREGf_CUTGROUP_SEEN,   "CUTGROUP_SEEN,"},
+    {PREGf_USE_RE_EVAL,            "USE_RE_EVAL,"},
+    {PREGf_NOSCAN,          "NOSCAN,"},
+};
+
 void
 Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim)
 {
@@ -2264,25 +2273,34 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
       dumpregexp:
        {
            struct regexp * const r = ReANY((REGEXP*)sv);
-#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags) STMT_START { \
+
+#define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \
             sv_setpv(d,"");                                 \
-            append_flags(d, flags, regexp_flags_names);     \
+            append_flags(d, flags, names);     \
             if (SvCUR(d) > 0 && *(SvEND(d) - 1) == ',') {       \
                 SvCUR_set(d, SvCUR(d) - 1);                 \
                 SvPVX(d)[SvCUR(d)] = '\0';                  \
             }                                               \
 } STMT_END
-            SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags);
+            SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->compflags,regexp_extflags_names);
             Perl_dump_indent(aTHX_ level, file, "  COMPFLAGS = 0x%"UVxf" (%s)\n",
                                 (UV)(r->compflags), SvPVX_const(d));
 
-            SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags);
+            SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names);
            Perl_dump_indent(aTHX_ level, file, "  EXTFLAGS = 0x%"UVxf" (%s)\n",
                                 (UV)(r->extflags), SvPVX_const(d));
-#undef SV_SET_STRINGIFY_REGEXP_FLAGS
 
-           Perl_dump_indent(aTHX_ level, file, "  INTFLAGS = 0x%"UVxf"\n",
+            Perl_dump_indent(aTHX_ level, file, "  ENGINE = 0x%"UVxf" (%s)\n",
+                                PTR2UV(r->engine), (r->engine == &PL_core_reg_engine) ? "STANDARD" : "PLUG-IN" );
+            if (r->engine == &PL_core_reg_engine) {
+                SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->intflags,regexp_core_intflags_names);
+                Perl_dump_indent(aTHX_ level, file, "  INTFLAGS = 0x%"UVxf" (%s)\n",
+                                (UV)(r->intflags), SvPVX_const(d));
+            } else {
+                Perl_dump_indent(aTHX_ level, file, "  INTFLAGS = 0x%"UVxf"\n",
                                (UV)(r->intflags));
+            }
+#undef SV_SET_STRINGIFY_REGEXP_FLAGS
            Perl_dump_indent(aTHX_ level, file, "  NPARENS = %"UVuf"\n",
                                (UV)(r->nparens));
            Perl_dump_indent(aTHX_ level, file, "  LASTPAREN = %"UVuf"\n",
@@ -2309,8 +2327,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                            pv_display(d, r->subbeg, r->sublen, 50, pvlim));
            else
                Perl_dump_indent(aTHX_ level, file, "  SUBBEG = 0x0\n");
-           Perl_dump_indent(aTHX_ level, file, "  ENGINE = 0x%"UVxf"\n",
-                               PTR2UV(r->engine));
            Perl_dump_indent(aTHX_ level, file, "  MOTHER_RE = 0x%"UVxf"\n",
                                PTR2UV(r->mother_re));
            if (nest < maxnest && r->mother_re)
index dbc9883..9fb1f01 100644 (file)
@@ -362,6 +362,7 @@ do_test('reference to named subroutine without prototype',
     OUTSIDE = $ADDR \\(MAIN\\)');
 
 if ($] >= 5.011) {
+# note the conditionals on ENGINE and INTFLAGS were introduced in 5.19.9
 do_test('reference to regexp',
         qr(tic),
 'SV = $RV\\($ADDR\\) at $ADDR
@@ -380,7 +381,8 @@ do_test('reference to regexp',
 '
     COMPFLAGS = 0x0 \(\)
     EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
-    INTFLAGS = 0x0
+(?:    ENGINE = $ADDR \(STANDARD\)
+)?    INTFLAGS = 0x0(?: \(\))?
     NPARENS = 0
     LASTPAREN = 0
     LASTCLOSEPAREN = 0
@@ -392,8 +394,8 @@ do_test('reference to regexp',
     SUBOFFSET = 0
     SUBCOFFSET = 0
     SUBBEG = 0x0
-    ENGINE = $ADDR
-    MOTHER_RE = $ADDR'
+(?:    ENGINE = $ADDR
+)?    MOTHER_RE = $ADDR'
 . ($] < 5.019003 ? '' : '
     SV = REGEXP\($ADDR\) at $ADDR
       REFCNT = 2
@@ -402,7 +404,8 @@ do_test('reference to regexp',
       CUR = 8
       COMPFLAGS = 0x0 \(\)
       EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
-      INTFLAGS = 0x0
+(?:      ENGINE = $ADDR \(STANDARD\)
+)?      INTFLAGS = 0x0(?: \(\))?
       NPARENS = 0
       LASTPAREN = 0
       LASTCLOSEPAREN = 0
@@ -414,8 +417,8 @@ do_test('reference to regexp',
       SUBOFFSET = 0
       SUBCOFFSET = 0
       SUBBEG = 0x0
-      ENGINE = $ADDR
-      MOTHER_RE = 0x0
+(?:    ENGINE = $ADDR
+)?      MOTHER_RE = 0x0
       PAREN_NAMES = 0x0
       SUBSTRS = $ADDR
       PPRIVATE = $ADDR
@@ -1198,7 +1201,7 @@ unless ($Config{useithreads}) {
     pass "no crash with DeadCode";
     close OUT;
 }
-
+# note the conditionals on ENGINE and INTFLAGS were introduced in 5.19.9
 do_test('UTF-8 in a regular expression',
         qr/\x{100}/,
 'SV = IV\($ADDR\) at $ADDR
@@ -1213,7 +1216,8 @@ do_test('UTF-8 in a regular expression',
     STASH = $ADDR      "Regexp"
     COMPFLAGS = 0x0 \(\)
     EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
-    INTFLAGS = 0x0
+(?:    ENGINE = $ADDR \(STANDARD\)
+)?    INTFLAGS = 0x0(?: \(\))?
     NPARENS = 0
     LASTPAREN = 0
     LASTCLOSEPAREN = 0
@@ -1225,8 +1229,8 @@ do_test('UTF-8 in a regular expression',
     SUBOFFSET = 0
     SUBCOFFSET = 0
     SUBBEG = 0x0
-    ENGINE = $ADDR
-    MOTHER_RE = $ADDR'
+(?:    ENGINE = $ADDR
+)?    MOTHER_RE = $ADDR'
 . ($] < 5.019003 ? '' : '
     SV = REGEXP\($ADDR\) at $ADDR
       REFCNT = 2
@@ -1235,7 +1239,8 @@ do_test('UTF-8 in a regular expression',
       CUR = 13
       COMPFLAGS = 0x0 \(\)
       EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
-      INTFLAGS = 0x0
+(?:      ENGINE = $ADDR \(STANDARD\)
+)?      INTFLAGS = 0x0(?: \(\))?
       NPARENS = 0
       LASTPAREN = 0
       LASTCLOSEPAREN = 0
@@ -1247,8 +1252,8 @@ do_test('UTF-8 in a regular expression',
       SUBOFFSET = 0
       SUBCOFFSET = 0
       SUBBEG = 0x0
-      ENGINE = $ADDR
-      MOTHER_RE = 0x0
+(?:    ENGINE = $ADDR
+)?      MOTHER_RE = 0x0
       PAREN_NAMES = 0x0
       SUBSTRS = $ADDR
       PPRIVATE = $ADDR
index dfbaec8..87e6dd8 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -6936,7 +6936,7 @@ reStudy:
            r->check_utf8 = r->anchored_utf8;
            r->check_offset_min = r->check_offset_max = r->anchored_offset;
            if (r->extflags & RXf_ANCH_SINGLE)
-               r->extflags |= RXf_NOSCAN;
+                r->intflags |= PREGf_NOSCAN;
        }
        else {
            r->check_end_shift = r->float_end_shift;
@@ -15391,7 +15391,7 @@ Perl_regdump(pTHX_ const regexp *r)
                      (r->check_substr == r->float_substr
                       && r->check_utf8 == r->float_utf8
                       ? "(checking floating" : "(checking anchored"));
-    if (r->extflags & RXf_NOSCAN)
+    if (r->intflags & PREGf_NOSCAN)
        PerlIO_printf(Perl_debug_log, " noscan");
     if (r->extflags & RXf_CHECK_ALL)
        PerlIO_printf(Perl_debug_log, " isall");
index da762cc..d8f60db 100644 (file)
--- a/regcomp.h
+++ b/regcomp.h
  *
  * See regexp.h for flags used externally to the regexp engine
  */
+#define RXp_INTFLAGS(rx)        ((rx)->intflags)
+#define RX_INTFLAGS(prog)        RXp_INTFLAGS(ReANY(prog))
+
 #define PREGf_SKIP             0x00000001
 #define PREGf_IMPLICIT         0x00000002 /* Converted .* to ^.* */
 #define PREGf_NAUGHTY          0x00000004 /* how exponential is this pattern? */
 #define PREGf_VERBARG_SEEN     0x00000008
 #define PREGf_CUTGROUP_SEEN    0x00000010
 #define PREGf_USE_RE_EVAL      0x00000020 /* compiled with "use re 'eval'" */
+/* these used to be extflags, but are now intflags */
+#define PREGf_NOSCAN            0x00000040
 
 
 /* this is where the old regcomp.h started */
index 477b075..aa1a2d0 100644 (file)
--- a/regexp.h
+++ b/regexp.h
@@ -402,7 +402,7 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
 #define RXf_CANY_SEEN          (1<<(RXf_BASE_SHIFT+8))
 
 /* Special */
-#define RXf_NOSCAN             (1<<(RXf_BASE_SHIFT+9))
+#define RXf_UNUSED1              (1<<(RXf_BASE_SHIFT+9))
 #define RXf_CHECK_ALL          (1<<(RXf_BASE_SHIFT+10))
 
 /* UTF8 related */