xgettext: Perl: Improve heuristic for format strings.

* gettext-tools/src/format-perl.c (struct spec): Add field
'likely_intentional_directives'.
(format_parse): Set it to the number of directives that don't contain a space.
(format_is_unlikely_intentional): New function.
(formatstring_perl): Use it.
* gettext-tools/tests/format-perl-3: New file.
* gettext-tools/tests/Makefile.am (TESTS): Add it.

gettext-tools/src/format-perl.c

@@ -108,6 +108,11 @@ struct numbered_arg
 struct spec
 {
   unsigned int directives;
+  /* We consider a directive as "likely intentional" if it does not contain a
+     space.  This prevents xgettext from flagging strings like "100% complete"
+     as 'perl-format' if they don't occur in a context that requires a format
+     string.  */
+  unsigned int likely_intentional_directives;
   unsigned int numbered_arg_count;
   struct numbered_arg *numbered;
 };
@@ -131,6 +136,7 @@ format_parse (const char *format, bool translated, char *fdi,
 {
   const char *const format_start = format;
   unsigned int directives;
+  unsigned int likely_intentional_directives;
   unsigned int numbered_arg_count;
   struct numbered_arg *numbered;
   unsigned int numbered_allocated;
@@ -138,6 +144,7 @@ format_parse (const char *format, bool translated, char *fdi,
   struct spec *result;
 
   directives = 0;
+  likely_intentional_directives = 0;
   numbered_arg_count = 0;
   numbered = NULL;
   numbered_allocated = 0;
@@ -151,6 +158,7 @@ format_parse (const char *format, bool translated, char *fdi,
         bool vectorize = false;
         format_arg_type_t type;
         format_arg_type_t size;
+        bool likely_intentional = true;
 
         FDI_SET (format - 1, FMTDIR_START);
         directives++;
@@ -177,7 +185,11 @@ format_parse (const char *format, bool translated, char *fdi,
         /* Parse flags.  */
         while (*format == ' ' || *format == '+' || *format == '-'
                || *format == '#' || *format == '0')
-          format++;
+          {
+            if (*format == ' ')
+              likely_intentional = false;
+            format++;
+          }
 
         /* Parse vector.  */
         if (*format == 'v')
@@ -463,6 +475,8 @@ format_parse (const char *format, bool translated, char *fdi,
             numbered_arg_count++;
           }
 
+        if (likely_intentional)
+          likely_intentional_directives++;
         FDI_SET (format, FMTDIR_END);
 
         format++;
@@ -517,6 +531,7 @@ format_parse (const char *format, bool translated, char *fdi,
 
   result = XMALLOC (struct spec);
   result->directives = directives;
+  result->likely_intentional_directives = likely_intentional_directives;
   result->numbered_arg_count = numbered_arg_count;
   result->numbered = numbered;
   return result;
@@ -545,6 +560,14 @@ format_get_number_of_directives (void *descr)
   return spec->directives;
 }
 
+static bool
+format_is_unlikely_intentional (void *descr)
+{
+  struct spec *spec = (struct spec *) descr;
+
+  return spec->likely_intentional_directives == 0;
+}
+
 static bool
 format_check (void *msgid_descr, void *msgstr_descr, bool equality,
               formatstring_error_logger_t error_logger, void *error_logger_data,
@@ -629,7 +652,7 @@ struct formatstring_parser formatstring_perl =
   format_parse,
   format_free,
   format_get_number_of_directives,
-  NULL,
+  format_is_unlikely_intentional,
   format_check
 };
 

gettext-tools/tests/Makefile.am

@@ -218,7 +218,7 @@ TESTS = gettext-1 gettext-2 \
 	format-python-1 format-python-2 \
 	format-python-brace-1 format-python-brace-2 \
 	format-pascal-1 format-pascal-2 \
-	format-perl-1 format-perl-2 \
+	format-perl-1 format-perl-2 format-perl-3 \
 	format-perl-brace-1 format-perl-brace-2 \
 	format-perl-mixed-1 format-perl-mixed-2 \
 	format-qt-1 format-qt-2 \

gettext-tools/tests/format-perl-3

@@ -0,0 +1,47 @@
+#! /bin/sh
+. "${srcdir=.}/init.sh"; path_prepend_ . ../src
+
+# Test heuristic recognition of Perl format strings like "100% complete".
+
+cat <<\EOF > f-pl-3.pl
+gettext("Test 1a is 100% complete");
+printf gettext("Test 1b is 100% complete"), 120;
+gettext("Test 2a from 0% complete to 100% complete");
+printf gettext("Test 2b from 0% complete to 100% complete"), 120, 121;
+gettext("Test 3a of %s is 100% complete");
+printf gettext("Test 3b of %s is 100% complete"), "foo", 120;
+EOF
+
+: ${XGETTEXT=xgettext}
+${XGETTEXT} --omit-header --no-location -d f-pl-3.tmp f-pl-3.pl || Exit 1
+LC_ALL=C tr -d '\r' < f-pl-3.tmp.po > f-pl-3.po || Exit 1
+
+cat <<\EOF > f-pl-3.ok
+msgid "Test 1a is 100% complete"
+msgstr ""
+
+#, perl-format
+msgid "Test 1b is 100% complete"
+msgstr ""
+
+msgid "Test 2a from 0% complete to 100% complete"
+msgstr ""
+
+#, perl-format
+msgid "Test 2b from 0% complete to 100% complete"
+msgstr ""
+
+#, perl-format
+msgid "Test 3a of %s is 100% complete"
+msgstr ""
+
+#, perl-format
+msgid "Test 3b of %s is 100% complete"
+msgstr ""
+EOF
+
+: ${DIFF=diff}
+${DIFF} f-pl-3.ok f-pl-3.po
+result=$?
+
+exit $result