From 337ff3078c4082e843af19536e11f70d3d14bfe9 Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Sat, 22 Jun 2013 18:16:36 +0200
Subject: [PATCH] Show intflags as well as extflags

---
 embed.fnc        |  1 +
 embed.h          |  1 +
 proto.h          |  1 +
 regcomp.c        | 28 +++++++++++++++++++++++++++-
 regen/regcomp.pl | 47 ++++++++++++++++++++++++++++++++++++++++++++++-
 regnodes.h       | 15 +++++++++++++++
 6 files changed, 91 insertions(+), 2 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index 6e6f2cd..d549962 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2047,6 +2047,7 @@ Es	|void	|make_trie_failtable	|NN struct RExC_state_t *pRExC_state \
                                 |NN regnode *source|NN regnode *stclass \
 				|U32 depth
 #  ifdef DEBUGGING
+Es        |void        |regdump_intflags|NULLOK const char *lead| const U32 flags
 Es	|void	|regdump_extflags|NULLOK const char *lead| const U32 flags
 Es	|const regnode*|dumpuntil|NN const regexp *r|NN const regnode *start \
 				|NN const regnode *node \
diff --git a/embed.h b/embed.h
index f2003af..8637471 100644
--- a/embed.h
+++ b/embed.h
@@ -878,6 +878,7 @@
 #define dumpuntil(a,b,c,d,e,f,g,h)	S_dumpuntil(aTHX_ a,b,c,d,e,f,g,h)
 #define put_byte(a,b)		S_put_byte(aTHX_ a,b)
 #define regdump_extflags(a,b)	S_regdump_extflags(aTHX_ a,b)
+#define regdump_intflags(a,b)        S_regdump_intflags(aTHX_ a,b)
 #define regtail_study(a,b,c,d)	S_regtail_study(aTHX_ a,b,c,d)
 #    endif
 #    if defined(PERL_IN_REGEXEC_C)
diff --git a/proto.h b/proto.h
index 3cebd4e..e7695a3 100644
--- a/proto.h
+++ b/proto.h
@@ -5188,6 +5188,7 @@ STATIC void	S_put_byte(pTHX_ SV* sv, int c)
 	assert(sv)
 
 STATIC void	S_regdump_extflags(pTHX_ const char *lead, const U32 flags);
+STATIC void        S_regdump_intflags(pTHX_ const char *lead, const U32 flags);
 STATIC U8	S_regtail_study(pTHX_ struct RExC_state_t *pRExC_state, regnode *p, const regnode *val, U32 depth)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2)
diff --git a/regcomp.c b/regcomp.c
index e660e5e..3cb7829 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -14446,6 +14446,29 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p, const regnode *val,
  - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
  */
 #ifdef DEBUGGING
+
+static void
+S_regdump_intflags(pTHX_ const char *lead, const U32 flags)
+{
+    int bit;
+    int set=0;
+    regex_charset cs;
+
+    for (bit=0; bit<32; bit++) {
+        if (flags & (1<<bit)) {
+            if (!set++ && lead)
+                PerlIO_printf(Perl_debug_log, "%s",lead);
+            PerlIO_printf(Perl_debug_log, "%s ",PL_reg_intflags_name[bit]);
+        }
+    }
+    if (lead)  {
+        if (set)
+            PerlIO_printf(Perl_debug_log, "\n");
+        else
+            PerlIO_printf(Perl_debug_log, "%s[none-set]\n",lead);
+    }
+}
+
 static void 
 S_regdump_extflags(pTHX_ const char *lead, const U32 flags)
 {
@@ -14578,7 +14601,10 @@ Perl_regdump(pTHX_ const regexp *r)
     if (r->extflags & RXf_EVAL_SEEN)
 	PerlIO_printf(Perl_debug_log, "with eval ");
     PerlIO_printf(Perl_debug_log, "\n");
-    DEBUG_FLAGS_r(regdump_extflags("r->extflags: ",r->extflags));            
+    DEBUG_FLAGS_r({
+        regdump_extflags("r->extflags: ",r->extflags);
+        regdump_intflags("r->intflags: ",r->intflags);
+    });
 #else
     PERL_ARGS_ASSERT_REGDUMP;
     PERL_UNUSED_CONTEXT;
diff --git a/regen/regcomp.pl b/regen/regcomp.pl
index 97719b0..4a8b9d5 100644
--- a/regen/regcomp.pl
+++ b/regen/regcomp.pl
@@ -245,6 +245,10 @@ print $out <<EOP;
 };
 #endif /* DOINIT */
 
+EOP
+
+{
+print $out <<EOP;
 /* PL_reg_extflags_name[] - Opcode/state names in string form, for debugging */
 
 #ifndef DOINIT
@@ -263,7 +267,7 @@ foreach my $file ("op_reg_common.h", "regexp.h") {
 
         # optional leading '_'.  Return symbol in $1, and strip it from
         # rest of line
-        if (s/ \# \s* define \s+ ( _? RXf_ \w+ ) \s+ //xi) {
+        if (s/^ \# \s* define \s+ ( _? RXf_ \w+ ) \s+ //xi) {
             chomp;
             my $define = $1;
             my $orig= $_;
@@ -335,6 +339,47 @@ print $out <<EOP;
 #endif /* DOINIT */
 
 EOP
+}
+{
+print $out <<EOP;
+/* PL_reg_intflags_name[] - Opcode/state names in string form, for debugging */
+
+#ifndef DOINIT
+EXTCONST char * PL_reg_intflags_name[];
+#else
+EXTCONST char * const PL_reg_intflags_name[] = {
+EOP
+
+my %rxfv;
+my %definitions;    # Remember what the symbol definitions are
+my $val = 0;
+my %reverse;
+foreach my $file ("regcomp.h") {
+    open my $fh, "<", $file or die "Can't read $file: $!";
+    while (<$fh>) {
+        # optional leading '_'.  Return symbol in $1, and strip it from
+        # rest of line
+        if (m/^ \# \s* define \s+ ( PREGf_ ( \w+ ) ) \s+ 0x([0-9a-f]+)(?:\s*\/\*(.*)\*\/)?/xi) {
+            chomp;
+            my $define = $1;
+            my $abbr= $2;
+            my $hex= $3;
+            my $comment= $4;
+            my $val= hex($hex);
+            $comment= $comment ? " - $comment" : "";
+
+            printf $out qq(\t%-30s/* 0x%08x - %s%s */\n), qq("$abbr",), $val, $define, $comment;
+        }
+    }
+}
+
+print $out <<EOP;
+};
+#endif /* DOINIT */
+
+EOP
+}
+
 
 print $out process_flags('V', 'varies', <<'EOC');
 /* The following have no fixed length. U8 so we can do strchr() on it. */
diff --git a/regnodes.h b/regnodes.h
index 0caf86d..d6c57e0 100644
--- a/regnodes.h
+++ b/regnodes.h
@@ -686,6 +686,21 @@ EXTCONST char * const PL_reg_extflags_name[] = {
 };
 #endif /* DOINIT */
 
+/* PL_reg_intflags_name[] - Opcode/state names in string form, for debugging */
+
+#ifndef DOINIT
+EXTCONST char * PL_reg_intflags_name[];
+#else
+EXTCONST char * const PL_reg_intflags_name[] = {
+        "SKIP",                       /* 0x00000001 - PREGf_SKIP */
+        "IMPLICIT",                   /* 0x00000002 - PREGf_IMPLICIT -  Converted .* to ^.*  */
+        "NAUGHTY",                    /* 0x00000004 - PREGf_NAUGHTY -  how exponential is this pattern?  */
+        "VERBARG_SEEN",               /* 0x00000008 - PREGf_VERBARG_SEEN */
+        "CUTGROUP_SEEN",              /* 0x00000010 - PREGf_CUTGROUP_SEEN */
+        "USE_RE_EVAL",                /* 0x00000020 - PREGf_USE_RE_EVAL -  compiled with "use re 'eval'"  */
+};
+#endif /* DOINIT */
+
 /* The following have no fixed length. U8 so we can do strchr() on it. */
 #define REGNODE_VARIES(node) (PL_varies_bitmask[(node) >> 3] & (1 << ((node) & 7)))
 
-- 
1.8.3.1