GH16319: avoid recursion parsing 'pack' template

A template with many open brackets or open parentheses could
overflow the stack, modify the parsing loop to avoid that.

Author: hvds

pod/perldiag.pod

@@ -3704,6 +3704,11 @@ See L</500 Server error>.
 by a missing delimiter on a string or pattern, because it eventually
 ended earlier on the current line.
 
+=item Mismatched brackets in template
+
+(F) A pack template could not be parsed because pairs of C<[...]> or
+C<(...)> could not be matched up. See L<perlfunc/pack>.
+
 =item Misplaced _ in number
 
 (W syntax) An underscore (underbar) in a numeric constant did not

pp_pack.c

@@ -541,22 +541,24 @@ STATIC const char *
 S_group_end(pTHX_ const char *patptr, const char *patend, char ender)
 {
     PERL_ARGS_ASSERT_GROUP_END;
+    Size_t opened = 0;  /* number of pending opened brackets */
 
     while (patptr < patend) {
         const char c = *patptr++;
 
-        if (isSPACE(c))
-            continue;
-        else if (c == ender)
+        if (opened == 0 && c == ender)
             return patptr-1;
         else if (c == '#') {
             while (patptr < patend && *patptr != '\n')
                 patptr++;
             continue;
-        } else if (c == '(')
-            patptr = group_end(patptr, patend, ')') + 1;
-        else if (c == '[')
-            patptr = group_end(patptr, patend, ']') + 1;
+        } else if (c == '(' || c == '[')
+            ++opened;
+        else if (c == ')' || c == ']') {
+            if (opened == 0)
+                Perl_croak(aTHX_ "Mismatched brackets in template");
+            --opened;
+        }
     }
     Perl_croak(aTHX_ "No group ending character '%c' found in template",
                ender);

t/op/pack.t

@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc(qw '../lib ../cpan/Math-BigInt/lib');
 }
 
-plan tests => 14720;
+plan tests => 14722;
 
 use strict;
 use warnings qw(FATAL all);
@@ -2044,3 +2044,14 @@ SKIP:
     fresh_perl_is('0.0 + unpack("u", "ab")', "", { stderr => 1 },
                   "ensure unpack u of invalid data nul terminates result");
 }
+
+{
+	# [GH #16319] SEGV caused by recursion
+	my $x = eval { pack "[" x 1_000_000 };
+	like("$@", qr{No group ending character \Q']'\E found in template},
+			"many opening brackets should not smash the stack");
+
+	$x = eval { pack "[(][)]" };
+	like("$@", qr{Mismatched brackets in template},
+			"should match brackets correctly even without recursion");
+}