From: Bruno Haible <bruno@clisp.org>
Date: Mon, 18 Sep 2023 18:58:32 +0000 (+0200)
Subject: xgettext: Perl: Avoid unnecessary nesting_depth growth.
X-Git-Tag: v0.22.1~7
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e3eba6012b4042b661e41bf8edbe62bea7fc4206;p=thirdparty%2Fgettext.git

xgettext: Perl: Avoid unnecessary nesting_depth growth.

* gettext-tools/src/x-perl.c: Ensure the top-level extract_balanced call returns
when a closing paren or bracket is seen.
(token_type_r_any): New enum item.
(prefer_regexp_over_division, extract_balanced): Handle it.
(extract_perl): Pass token_type_r_any instead of token_type_rbrace.
---

diff --git a/gettext-tools/src/x-perl.c b/gettext-tools/src/x-perl.c
index 756d2a383..7f2e93ff4 100644
--- a/gettext-tools/src/x-perl.c
+++ b/gettext-tools/src/x-perl.c
@@ -546,7 +546,7 @@ enum token_type_ty
   token_type_lbracket,          /* [ */
   token_type_rbracket,          /* ] */
   token_type_string,            /* quote-like */
-  token_type_number,            /* starting with a digit o dot */
+  token_type_number,            /* starting with a digit or dot */
   token_type_named_op,          /* if, unless, while, ... */
   token_type_variable,          /* $... */
   token_type_object,            /* A dereferenced variable, maybe a blessed
@@ -557,7 +557,8 @@ enum token_type_ty
   token_type_other,             /* regexp, misc. operator */
   /* The following are not really token types, but variants used by
      the parser.  */
-  token_type_keyword_symbol     /* keyword symbol */
+  token_type_keyword_symbol,    /* keyword symbol */
+  token_type_r_any              /* rparen rbrace rbracket */
 };
 typedef enum token_type_ty token_type_ty;
 
@@ -2163,6 +2164,9 @@ prefer_regexp_over_division (token_type_ty type)
       case token_type_other:
         retval = true;
         break;
+      case token_type_r_any:
+        retval = false;
+        break;
   }
 
   #if DEBUG_PERL
@@ -3093,7 +3097,7 @@ collect_message (message_list_ty *mlp, token_ty *tp, int error_level)
    Extracted messages are added to MLP.
 
    DELIM can be either token_type_rbrace, token_type_rbracket,
-   token_type_rparen.
+   token_type_rparen, or token_type_r_any.
    Additionally, if SEMICOLON_DELIM is true, parsing stops at the next
    semicolon outside parentheses.
    Similarly, if COMMA_DELIM is true, parsing stops at the next comma
@@ -3163,7 +3167,11 @@ extract_balanced (message_list_ty *mlp,
                       && tp->sub_type == symbol_type_sub);
         }
 
-      if (delim == tp->type)
+      if (delim == tp->type
+          || (delim == token_type_r_any
+              && (tp->type == token_type_rparen
+                  || tp->type == token_type_rbrace
+                  || tp->type == token_type_rbracket)))
         {
           arglist_parser_done (argparser, arg);
           if (next_argparser != NULL)
@@ -3752,9 +3760,10 @@ extract_perl (FILE *f, const char *real_filename, const char *logical_filename,
   init_keywords ();
 
   /* Eat tokens until eof is seen.  When extract_balanced returns due to an
-     unbalanced closing brace or due to a semicolon, just restart it.  */
+     unbalanced closing paren / brace / bracket or due to a semicolon, just
+     restart it.  */
   while (!extract_balanced (mlp,
-                            token_type_rbrace, true,
+                            token_type_r_any, true,
                             true, true, false,
                             null_context, null_context_list_iterator,
                             1, arglist_parser_alloc (mlp, NULL)))