regcomp.c - increase size of CURLY nodes so the min/max is a I32

This allows us to resolve a test inconsistency between CURLYX and CURLY
and CURLYM, which have different maximums. We use I32 and not U32 because
the existing count logic uses -1 internally and using an I32 for the min/max
prevents warnings about comparing signed and unsigned values when the
count is compared against the min or max.

Author: demerphq

regcomp.c

@@ -4739,13 +4739,13 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
         if (RExC_use_BRANCHJ) {
             reginsert(pRExC_state, LONGJMP, ret, depth+1);
             reginsert(pRExC_state, NOTHING, ret, depth+1);
-            NEXT_OFF(REGNODE_p(ret)) = 3;        /* Go over LONGJMP. */
+            REGNODE_STEP_OVER(ret,tregnode_NOTHING,tregnode_LONGJMP,3);
         }
         reginsert(pRExC_state, CURLYX, ret, depth+1);
-
         if (RExC_use_BRANCHJ)
-            NEXT_OFF(REGNODE_p(ret)) = 3;   /* Go over NOTHING to
-                                               LONGJMP. */
+            /* Go over NOTHING to LONGJMP. */
+            REGNODE_STEP_OVER(ret,tregnode_CURLYX,tregnode_NOTHING,3);
+
         if (! REGTAIL(pRExC_state, ret, reg_node(pRExC_state,
                                                   NOTHING)))
         {
@@ -4758,8 +4758,8 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
     /* Finish up the CURLY/CURLYX case */
     FLAGS(REGNODE_p(ret)) = 0;
 
-    ARG1_SET(REGNODE_p(ret), (U16)min);
-    ARG2_SET(REGNODE_p(ret), (U16)max);
+    ARG1_SET(REGNODE_p(ret), min);
+    ARG2_SET(REGNODE_p(ret), max);
 
   done_main_op:
 

regcomp.h

@@ -216,13 +216,13 @@ struct regnode_2L {
     I32 arg2;
 };
 
-/* 'Two field' -- Two 16 bit unsigned args */
+/* 'Two field' -- Two 32 bit signed args */
 struct regnode_2 {
     U8	flags;
     U8  type;
     U16 next_off;
-    U16 arg1;
-    U16 arg2;
+    I32 arg1;
+    I32 arg2;
 };
 
 #define REGNODE_BBM_BITMAP_LEN                                                  \
@@ -317,22 +317,22 @@ struct regnode_ssc {
    Impose a limit of REG_INFTY on various pattern matching operations
    to limit stack growth and to avoid "infinite" recursions.
 */
-/* The default size for REG_INFTY is U16_MAX, which is the same as
-   USHORT_MAX (see perl.h).  Unfortunately U16 isn't necessarily 16 bits
-   (see handy.h).  On the Cray C90, sizeof(short)==4 and hence U16_MAX is
-   ((1<<32)-1), while on the Cray T90, sizeof(short)==8 and U16_MAX is
-   ((1<<64)-1).  To limit stack growth to reasonable sizes, supply a
+/* The default size for REG_INFTY is I32_MAX, which is the same as UINT_MAX
+   (see perl.h). Unfortunately I32 isn't necessarily 32 bits (see handy.h).
+   On the Cray C90, or Cray T90, I32_MAX is considerably larger than it
+   might be elsewhere. To limit stack growth to reasonable sizes, supply a
    smaller default.
         --Andy Dougherty  11 June 1998
+        --Amended by Yves Orton 15 Jan 2023
 */
-#if SHORTSIZE > 2
+#if INTSIZE > 4
 #  ifndef REG_INFTY
-#    define REG_INFTY  nBIT_UMAX(16)
+#    define REG_INFTY  nBIT_IMAX(32)
 #  endif
 #endif
 
 #ifndef REG_INFTY
-#  define REG_INFTY U16_MAX
+#  define REG_INFTY I32_MAX
 #endif
 
 #define ARG_VALUE(arg) (arg)

regcomp_internal.h

@@ -1245,5 +1245,7 @@ static const scan_data_t zero_scan_data = {
     CLEAR_OPTSTART;                                             \
     node = dumpuntil(r,start,(b),(e),last,sv,indent+1,depth+1);
 
+#define REGNODE_STEP_OVER(ret,t1,t2,k) \
+    NEXT_OFF(REGNODE_p(ret)) = ((sizeof(t1)+sizeof(t2))/sizeof(regnode))
 
 #endif /* REGCOMP_INTERNAL_H */

t/re/pat.t

@@ -350,31 +350,36 @@ sub run_tests {
 
 	#  Defaults assumed if this fails
 	eval { require Config; };
-        $::reg_infty   = $Config::Config{reg_infty} // 65535;
+        $::reg_infty   = $Config::Config{reg_infty} // ((1<<31)-1);
         $::reg_infty_m = $::reg_infty - 1;
         $::reg_infty_p = $::reg_infty + 1;
         $::reg_infty_m = $::reg_infty_m;   # Suppress warning.
 
         # As well as failing if the pattern matches do unexpected things, the
         # next three tests will fail if you should have picked up a lower-than-
         # default value for $reg_infty from Config.pm, but have not.
-
-        is(eval q{('aaa' =~ /(a{1,$::reg_infty_m})/)[0]}, 'aaa', $message);
-        is($@, '', $message);
-        is(eval q{('a' x $::reg_infty_m) =~ /a{$::reg_infty_m}/}, 1, $message);
-        is($@, '', $message);
-        isnt(q{('a' x ($::reg_infty_m - 1)) !~ /a{$::reg_infty_m}/}, 1, $message);
-        is($@, '', $message);
+        SKIP: {
+            skip "REG_INFTY too big to test ($::reg_infty)", 7
+                if $::reg_infty > (1<<16);
+
+            is(eval q{('aaa' =~ /(a{1,$::reg_infty_m})/)[0]}, 'aaa', $message);
+            is($@, '', $message);
+            is(eval q{('a' x $::reg_infty_m) =~ /a{$::reg_infty_m}/}, 1, $message);
+            is($@, '', $message);
+            isnt(q{('a' x ($::reg_infty_m - 1)) !~ /a{$::reg_infty_m}/}, 1, $message);
+            is($@, '', $message);
+
+            # It should be 'a' x 2147483647, but that exhausts memory on
+            # reasonably sized modern machines
+            like('a' x $::reg_infty_m, qr/a{1,}/,
+                 "{1,} matches more times than REG_INFTY");
+        }
 
         eval "'aaa' =~ /a{1,$::reg_infty}/";
         like($@, qr/^\QQuantifier in {,} bigger than/, $message);
         eval "'aaa' =~ /a{1,$::reg_infty_p}/";
         like($@, qr/^\QQuantifier in {,} bigger than/, $message);
 
-        # It should be 'a' x 2147483647, but that exhausts memory on
-        # reasonably sized modern machines
-        like('a' x $::reg_infty_p, qr/a{1,}/,
-             "{1,} matches more times than REG_INFTY");
     }
 
     {
@@ -393,12 +398,17 @@ sub run_tests {
 
         for my $l (@trials) { # Ordered to free memory
             my $a = 'a' x $l;
-	    my $message = "Long monster, length = $l";
-	    like("ba$a=", qr/a$a=/, $message);
-            unlike("b$a=", qr/a$a=/, $message);
-            like("b$a=", qr/ba+=/, $message);
-
-	    like("ba$a=", qr/b(?:a|b)+=/, $message);
+            # we do not use like() or unlike() here as the string
+            # is very long and is not useful if the match fails,
+            # the useful part
+	    ok("ba$a=" =~ m/a$a=/, sprintf
+                'Long monster: ("ba".("a" x %d)."=") =~ m/aa...a=/', $l);
+            ok("b$a="  !~ m/a$a=/, sprintf
+                'Long monster: ("b" .("a" x %d)."=") !~ m/aa...a=/', $l);
+            ok("b$a="  =~ m/ba+=/, sprintf
+                'Long monster: ("b" .("a" x %d)."=") =~ m/ba+=/', $l);
+	    ok("ba$a=" =~ m/b(?:a|b)+=/, sprintf
+                'Long monster: ("ba".("a" x %d)."=") =~ m/b(?:a|b)+=/', $l);
         }
     }
 

t/re/reg_mesg.t

@@ -108,7 +108,7 @@ sub mark_as_utf8 {
     return @ret;
 }
 
-my $inf_m1 = ($Config::Config{reg_infty} || 65535) - 1;
+my $inf_m1 = ($Config::Config{reg_infty} || ((1<<31)-1)) - 1;
 my $inf_p1 = $inf_m1 + 2;
 
 my $B_hex = sprintf("\\x%02X", ord "B");