In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/fd41b2d1cbe9a90b3c4c9c4f4fe1b72ac724fdbb?hp=4b7718d6473358b565848ae4b0eccda8315d96e6>

- Log -----------------------------------------------------------------
commit fd41b2d1cbe9a90b3c4c9c4f4fe1b72ac724fdbb
Author: Karl Williamson <[email protected]>
Date:   Mon Aug 26 11:53:06 2019 -0600

    Add ability to dump pre-optimized compiled pattern
    
    in qr//

commit 9aae37edc3bbb46850997959dce7432265b1e74a
Author: Karl Williamson <[email protected]>
Date:   Mon Aug 26 11:48:50 2019 -0600

    ext/re/re.pm: Clarify pod slightly

commit 650644160a0381f30882237a522166a9dc31caa9
Author: Karl Williamson <[email protected]>
Date:   Mon Aug 26 11:47:40 2019 -0600

    ext/re/re.pm: White-space only, bump version

commit e1ebd5bbc93ab32c196f758f00d92ca1e6cec0a1
Author: Karl Williamson <[email protected]>
Date:   Fri Aug 23 12:38:50 2019 -0600

    embed.fnc: Add caution about R flag

-----------------------------------------------------------------------

Summary of changes:
 embed.fnc         |  4 ++++
 ext/re/re.pm      | 63 ++++++++++++++++++++++++++++++-------------------------
 pod/perldelta.pod |  9 ++++++++
 regcomp.c         | 10 +++++++++
 regcomp.h         | 22 +++++++++++--------
 5 files changed, 71 insertions(+), 37 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index 02b2ea3b18..c9230aacbb 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -216,6 +216,10 @@
 :
 :   R  Return value must not be ignored (also implied by 'a' and 'P' flags):
 :
+:      gcc has a bug (which they claim is a feature) in which casting the
+:       result of one of these to (void) doesn't silence the warning that the
+:      result is ignored.
+:
 :        proto.h: add __attribute__warn_unused_result__
 :
 :   r  Function never returns:
diff --git a/ext/re/re.pm b/ext/re/re.pm
index 817b522c28..3825e5191e 100644
--- a/ext/re/re.pm
+++ b/ext/re/re.pm
@@ -4,7 +4,7 @@ package re;
 use strict;
 use warnings;
 
-our $VERSION     = "0.37";
+our $VERSION     = "0.38";
 our @ISA         = qw(Exporter);
 our @EXPORT_OK   = ('regmust',
                     qw(is_regexp regexp_pattern
@@ -54,33 +54,36 @@ sub setcolor {
 }
 
 my %flags = (
-    COMPILE         => 0x0000FF,
-    PARSE           => 0x000001,
-    OPTIMISE        => 0x000002,
-    TRIEC           => 0x000004,
-    DUMP            => 0x000008,
-    FLAGS           => 0x000010,
-    TEST            => 0x000020,
-
-    EXECUTE         => 0x00FF00,
-    INTUIT          => 0x000100,
-    MATCH           => 0x000200,
-    TRIEE           => 0x000400,
-
-    EXTRA           => 0xFF0000,
-    TRIEM           => 0x010000,
-    OFFSETS         => 0x020000,
-    OFFSETSDBG      => 0x040000,
-    STATE           => 0x080000,
-    OPTIMISEM       => 0x100000,
-    STACK           => 0x280000,
-    BUFFERS         => 0x400000,
-    GPOS            => 0x800000,
+    COMPILE           => 0x0000FF,
+    PARSE             => 0x000001,
+    OPTIMISE          => 0x000002,
+    TRIEC             => 0x000004,
+    DUMP              => 0x000008,
+    FLAGS             => 0x000010,
+    TEST              => 0x000020,
+
+    EXECUTE           => 0x00FF00,
+    INTUIT            => 0x000100,
+    MATCH             => 0x000200,
+    TRIEE             => 0x000400,
+
+    EXTRA             => 0x1FF0000,
+    TRIEM             => 0x0010000,
+    OFFSETS           => 0x0020000,
+    OFFSETSDBG        => 0x0040000,
+    STATE             => 0x0080000,
+    OPTIMISEM         => 0x0100000,
+    STACK             => 0x0280000,
+    BUFFERS           => 0x0400000,
+    GPOS              => 0x0800000,
+    DUMP_PRE_OPTIMIZE => 0x1000000,
 );
-$flags{ALL} = -1 & ~($flags{OFFSETS}|$flags{OFFSETSDBG}|$flags{BUFFERS});
+$flags{ALL} = -1 &
+ 
~($flags{OFFSETS}|$flags{OFFSETSDBG}|$flags{BUFFERS}|$flags{DUMP_PRE_OPTIMIZE});
 $flags{All} = $flags{all} = $flags{DUMP} | $flags{EXECUTE};
 $flags{Extra} = $flags{EXECUTE} | $flags{COMPILE} | $flags{GPOS};
-$flags{More} = $flags{MORE} = $flags{All} | $flags{TRIEC} | $flags{TRIEM} | 
$flags{STATE};
+$flags{More} = $flags{MORE} =
+                    $flags{All} | $flags{TRIEC} | $flags{TRIEM} | 
$flags{STATE};
 $flags{State} = $flags{DUMP} | $flags{EXECUTE} | $flags{STATE};
 $flags{TRIE} = $flags{DUMP} | $flags{EXECUTE} | $flags{TRIEC};
 
@@ -510,7 +513,7 @@ purposes. The options are as follows:
 
 =item COMPILE
 
-Turns on all compile related debug options.
+Turns on all non-extra compile related debug options.
 
 =item PARSE
 
@@ -544,7 +547,7 @@ Print output intended for testing the internals of the 
compile process
 
 =item EXECUTE
 
-Turns on all execute related debug options.
+Turns on all non-extra execute related debug options.
 
 =item MATCH
 
@@ -617,6 +620,9 @@ debug options.
 Almost definitely only useful to people hacking
 on the offsets part of the debug engine.
 
+=item DUMP_PRE_OPTIMIZE
+
+Enable the dumping of the compiled pattern before the optimization phase.
 
 =back
 
@@ -628,7 +634,8 @@ These are useful shortcuts to save on the typing.
 
 =item ALL
 
-Enable all options at once except OFFSETS, OFFSETSDBG and BUFFERS.
+Enable all options at once except OFFSETS, OFFSETSDBG and BUFFERS and
+DUMP_PRE_OPTIMIZE.
 (To get every single option without exception, use both ALL and EXTRA, or
 starting in 5.30 on a C<-DDEBUGGING>-enabled perl interpreter, use
 the B<-Drv> command-line switches.)
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index f9573c6b4d..5d967b3251 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -27,6 +27,15 @@ here, but most should go in the L</Performance Enhancements> 
section.
 
 [ List each enhancement as a =head2 entry ]
 
+=head2 Now can dump compiled pattern before optimization
+
+This is primarily useful for tracking down bugs in the regular
+expression compiler.  This dump happens on C<-DDEBUGGING> perls, if you
+specify C<-Drv> on the command line; or on any perl if the pattern is
+compiled within the scope of S<C<use re qw(Debug DUMP_PRE_OPTIMIZE)>> or
+S<C<use re qw(Debug COMPILE EXTRA)>>.  (All but the 2nd case display
+other information as well.)
+
 =head1 Security
 
 XXX Any security-related notices go here.  In particular, any security
diff --git a/regcomp.c b/regcomp.c
index 6aea5c4ff5..05dd9a5e7b 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -7844,6 +7844,16 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int 
pat_count,
     SetProgLen(RExC_rxi,RExC_size);
 #endif
 
+    DEBUG_DUMP_PRE_OPTIMIZE_r({
+        SV * const sv = sv_newmortal();
+        RXi_GET_DECL(RExC_rx, ri);
+        DEBUG_RExC_seen();
+        Perl_re_printf( aTHX_ "Program before optimization:\n");
+
+        (void)dumpuntil(RExC_rx, ri->program, ri->program + 1, NULL, NULL,
+                        sv, 0, 0);
+    });
+
     DEBUG_OPTIMISE_r(
         Perl_re_printf( aTHX_  "Starting post parse optimization\n");
     );
diff --git a/regcomp.h b/regcomp.h
index aaf65c3331..62f4398ed1 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -997,16 +997,17 @@ re.pm, especially to the documentation.
 #define RE_DEBUG_EXECUTE_TRIE      0x000400
 
 /* Extra */
-#define RE_DEBUG_EXTRA_MASK        0xFF0000
-#define RE_DEBUG_EXTRA_TRIE        0x010000
-#define RE_DEBUG_EXTRA_OFFSETS     0x020000
-#define RE_DEBUG_EXTRA_OFFDEBUG    0x040000
-#define RE_DEBUG_EXTRA_STATE       0x080000
-#define RE_DEBUG_EXTRA_OPTIMISE    0x100000
-#define RE_DEBUG_EXTRA_BUFFERS     0x400000
-#define RE_DEBUG_EXTRA_GPOS        0x800000
+#define RE_DEBUG_EXTRA_MASK              0x1FF0000
+#define RE_DEBUG_EXTRA_TRIE              0x0010000
+#define RE_DEBUG_EXTRA_OFFSETS           0x0020000
+#define RE_DEBUG_EXTRA_OFFDEBUG          0x0040000
+#define RE_DEBUG_EXTRA_STATE             0x0080000
+#define RE_DEBUG_EXTRA_OPTIMISE          0x0100000
+#define RE_DEBUG_EXTRA_BUFFERS           0x0400000
+#define RE_DEBUG_EXTRA_GPOS              0x0800000
+#define RE_DEBUG_EXTRA_DUMP_PRE_OPTIMIZE 0x1000000
 /* combined */
-#define RE_DEBUG_EXTRA_STACK       0x280000
+#define RE_DEBUG_EXTRA_STACK             0x0280000
 
 #define RE_DEBUG_FLAG(x) (re_debug_flags & x)
 /* Compile */
@@ -1063,6 +1064,9 @@ re.pm, especially to the documentation.
 #define DEBUG_GPOS_r(x) DEBUG_r( \
     if (DEBUG_v_TEST || (re_debug_flags & RE_DEBUG_EXTRA_GPOS)) x )
 
+#define DEBUG_DUMP_PRE_OPTIMIZE_r(x) DEBUG_r( \
+    if (DEBUG_v_TEST || (re_debug_flags & RE_DEBUG_EXTRA_DUMP_PRE_OPTIMIZE)) x 
)
+
 /* initialization */
 /* get_sv() can return NULL during global destruction. */
 #define GET_RE_DEBUG_FLAGS DEBUG_r({ \

-- 
Perl5 Master Repository

Reply via email to