04bfb0
From cc16d262eb72677cdda2aa9395e943818b85ba38 Mon Sep 17 00:00:00 2001
04bfb0
From: Karl Williamson <khw@cpan.org>
04bfb0
Date: Mon, 29 Apr 2019 15:24:18 -0600
04bfb0
Subject: [PATCH] PATCH: [perl #134059] panic outputting a warning
04bfb0
MIME-Version: 1.0
04bfb0
Content-Type: text/plain; charset=UTF-8
04bfb0
Content-Transfer-Encoding: 8bit
04bfb0
04bfb0
This was due to a logic error on my part.  We need to save and restore a
04bfb0
value.  Instead, it was getting restored to the wrong value.
04bfb0
04bfb0
This particular instance of the bug was outputting a fatal error
04bfb0
message, so that the only harm is not giving the user the correct info,
04bfb0
and creating unnecessary work for them and us when it gets reported.
04bfb0
But this bug could manifest itself when trying to output just a warning
04bfb0
that the program otherwise would carry on from.
04bfb0
04bfb0
Signed-off-by: Petr Písař <ppisar@redhat.com>
04bfb0
---
04bfb0
 regcomp.c       | 12 ++++++++++--
04bfb0
 t/re/reg_mesg.t |  1 +
04bfb0
 2 files changed, 11 insertions(+), 2 deletions(-)
04bfb0
04bfb0
diff --git a/regcomp.c b/regcomp.c
04bfb0
index 3ad09c52b2..1c54fe3f38 100644
04bfb0
--- a/regcomp.c
04bfb0
+++ b/regcomp.c
04bfb0
@@ -131,6 +131,8 @@ struct RExC_state_t {
04bfb0
     char	*parse;			/* Input-scan pointer. */
04bfb0
     char        *copy_start;            /* start of copy of input within
04bfb0
                                            constructed parse string */
04bfb0
+    char        *save_copy_start;       /* Provides one level of saving
04bfb0
+                                           and restoring 'copy_start' */
04bfb0
     char        *copy_start_in_input;   /* Position in input string
04bfb0
                                            corresponding to copy_start */
04bfb0
     SSize_t	whilem_seen;		/* number of WHILEM in this expr */
04bfb0
@@ -229,6 +231,7 @@ struct RExC_state_t {
04bfb0
 #define RExC_precomp	(pRExC_state->precomp)
04bfb0
 #define RExC_copy_start_in_input (pRExC_state->copy_start_in_input)
04bfb0
 #define RExC_copy_start_in_constructed  (pRExC_state->copy_start)
04bfb0
+#define RExC_save_copy_start_in_constructed  (pRExC_state->save_copy_start)
04bfb0
 #define RExC_precomp_end (pRExC_state->precomp_end)
04bfb0
 #define RExC_rx_sv	(pRExC_state->rx_sv)
04bfb0
 #define RExC_rx		(pRExC_state->rx)
04bfb0
@@ -821,8 +824,13 @@ static const scan_data_t zero_scan_data = {
04bfb0
 } STMT_END
04bfb0
 
04bfb0
 /* Setting this to NULL is a signal to not output warnings */
04bfb0
-#define TURN_OFF_WARNINGS_IN_SUBSTITUTE_PARSE RExC_copy_start_in_constructed = NULL
04bfb0
-#define RESTORE_WARNINGS RExC_copy_start_in_constructed = RExC_precomp
04bfb0
+#define TURN_OFF_WARNINGS_IN_SUBSTITUTE_PARSE                               \
04bfb0
+    STMT_START {                                                            \
04bfb0
+      RExC_save_copy_start_in_constructed  = RExC_copy_start_in_constructed;\
04bfb0
+      RExC_copy_start_in_constructed = NULL;                                \
04bfb0
+    } STMT_END
04bfb0
+#define RESTORE_WARNINGS                                                    \
04bfb0
+    RExC_copy_start_in_constructed = RExC_save_copy_start_in_constructed
04bfb0
 
04bfb0
 /* Since a warning can be generated multiple times as the input is reparsed, we
04bfb0
  * output it the first time we come to that point in the parse, but suppress it
04bfb0
diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
04bfb0
index c5c79f0323..d10fa2c09a 100644
04bfb0
--- a/t/re/reg_mesg.t
04bfb0
+++ b/t/re/reg_mesg.t
04bfb0
@@ -318,6 +318,7 @@ my @death =
04bfb0
  '/\p{Is_Other_Alphabetic=F}/ ' => 'Can\'t find Unicode property definition "Is_Other_Alphabetic=F" {#} m/\p{Is_Other_Alphabetic=F}{#}/',
04bfb0
  '/\x{100}(?(/' => 'Unknown switch condition (?(...)) {#} m/\\x{100}(?({#}/', # [perl #133896]
04bfb0
  '/(?[\N{KEYCAP DIGIT NINE}/' => '\N{} in inverted character class or as a range end-point is restricted to one character {#} m/(?[\\N{U+39.FE0F.20E3{#}}/', # [perl #133988]
04bfb0
+ '/0000000000000000[\N{U+0.00}0000/' => 'Unmatched [ {#} m/0000000000000000[{#}\N{U+0.00}0000/', # [perl #134059]
04bfb0
 );
04bfb0
 
04bfb0
 # These are messages that are death under 'use re "strict"', and may or may
04bfb0
-- 
04bfb0
2.20.1
04bfb0