PATCH: [perl #82954] Make "Can't do {n,m} with n > m into warning

This commit now causes this situation to warn instead of dying.  The
portion of the regular expression that can't match is optimized into an
OPFAIL.

5 files changed, 34 insertions, 12 deletions

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 05f5946387..957154bd3f 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -558,6 +558,12 @@ etc changing if the original string changed.  That's now been fixed.
 Perl doesn't use PerlIO anymore to report out of memory messages, as PerlIO
 might attempt to allocate more memory.
 
+=item *
+
+In a regular expression, if something is quantified with C<{n,m}>
+where C<S<n E<gt> m>>, it can't possibly match.  Previously this was a fatal error,
+but now is merely a warning (and that something won't match).  [perl #82954].
+
 =back
 
 =head1 Known Problems
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 0de3c1adb6..3618d7972c 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -730,13 +730,6 @@ C<-i.bak>, or some such.
 characters and Perl was unable to create a unique filename during
 inplace editing with the B<-i> switch.  The file was ignored.
 
-=item Can't do {n,m} with n > m in regex; marked by <-- HERE in m/%s/
-
-(F) Minima must be less than or equal to maxima.  If you really
-want your regexp to match something 0 times, just put {0}.  The
-<-- HERE shows in the regular expression about where the problem
-was discovered.  See L<perlre>.
-
 =item Can't do waitpid with flags
 
 (F) This machine doesn't have either waitpid() or wait4(), so only
@@ -4090,6 +4083,11 @@ C</abc(?=(?:xyz){3})/>, not C</abc(?=xyz){3}/>.
 The <-- HERE shows in the regular expression about where the problem was
 discovered.
 
+=item Quantifier {n,m} with n > m can't match in regex
+
+(W regexp) Minima should be less than or equal to maxima.  If you really
+want your regexp to match something 0 times, just put {0}.
+
 =item Range iterator outside integer range
 
 (F) One (or both) of the numeric arguments to the range operator ".."
diff --git a/regcomp.c b/regcomp.c
index 10745e9066..1236f53a96 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -9456,6 +9456,10 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
     char *parse_start;
 #endif
     const char *maxpos = NULL;
+
+    /* Save the original in case we change the emitted regop to a FAIL. */
+    regnode * const orig_emit = RExC_emit;
+
     GET_RE_DEBUG_FLAGS_DECL;
 
     PERL_ARGS_ASSERT_REGPIECE;
@@ -9502,6 +9506,23 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
 		vFAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1);
 	    RExC_parse = next;
 	    nextchar(pRExC_state);
+            if (max < min) {    /* If can't match, warn and optimize to fail
+                                   unconditionally */
+                if (SIZE_ONLY) {
+                    ckWARNreg(RExC_parse, "Quantifier {n,m} with n > m can't match");
+
+                    /* We can't back off the size because we have to reserve
+                     * enough space for all the things we are about to throw
+                     * away, but we can shrink it by the ammount we are about
+                     * to re-use here */
+                    RExC_size = PREVOPER(RExC_size) - regarglen[(U8)OPFAIL];
+                }
+                else {
+                    RExC_emit = orig_emit;
+                }
+                ret = reg_node(pRExC_state, OPFAIL);
+                return ret;
+            }
 
 	do_curly:
 	    if ((flags&SIMPLE)) {
@@ -9539,8 +9560,6 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
 		*flagp = WORST;
 	    if (max > 0)
 		*flagp |= HASWIDTH;
-	    if (max < min)
-		vFAIL("Can't do {n,m} with n > m");
 	    if (!SIZE_ONLY) {
 		ARG1_SET(ret, (U16)min);
 		ARG2_SET(ret, (U16)max);
diff --git a/t/re/re_tests b/t/re/re_tests
index 1aebbe6963..bf1dc52bc2 100644
--- a/t/re/re_tests
+++ b/t/re/re_tests
@@ -650,8 +650,7 @@ $(?<=^(a))	a	y	$1	a
 (?>(a+))b	aaab	y	$1	aaa
 ((?>[^()]+)|\([^()]*\))+	((abc(ade)ufh()()x	y	$&	abc(ade)ufh()()x
 (?<=x+)y	-	c	-	Variable length lookbehind not implemented
-a{37,17}	-	c	-	Can't do {n,m} with n > m
-a{37,0}	-	c	-	Can't do {n,m} with n > m
+((def){37,17})?ABC	ABC	y	$&	ABC
 \Z	a\nb\n	y	$-[0]	3
 \z	a\nb\n	y	$-[0]	4
 $	a\nb\n	y	$-[0]	3
diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
index 0241cd5f43..aeb62e6dfe 100644
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -74,7 +74,6 @@ my @death =
 
  "/x{$inf_p1}/" => "Quantifier in {,} bigger than $inf_m1 in regex; marked by {#} in m/x{{#}$inf_p1}/",
 
- '/x{3,1}/' => 'Can\'t do {n,m} with n > m in regex; marked by {#} in m/x{3,1}{#}/',
 
  '/x**/' => 'Nested quantifiers in regex; marked by {#} in m/x**{#}/',
 
@@ -126,6 +125,7 @@ my @warning = (
     'm/[a-\pM]/' => 'False [] range "a-\pM" in regex; marked by {#} in m/[a-\pM{#}]/',
     'm/[\pM-x]/' => 'False [] range "\pM-" in regex; marked by {#} in m/[\pM-{#}x]/',
     "m'\\y'"     => 'Unrecognized escape \y passed through in regex; marked by {#} in m/\y{#}/',
+    '/x{3,1}/'   => 'Quantifier {n,m} with n > m can\'t match in regex; marked by {#} in m/x{3,1}{#}/',
 );
 
 while (my ($regex, $expect) = splice @death, 0, 2) {