Re: Bug#386912: errors in the Perl parser of xgettext: invalid variable interpolation at "$"

[Bruno Haible]

Hello,

Nicolas François / Nekral wrote:
> dpkg currently fails to update its POTs which contain strings extracted
> from Perl scripts.
> 
> The attached Perl script is a minimal example to reproduce this bug.
> It also gives some ideas on how to fix the perl scripts to bypass the bug.
> 
>     xgettext -k_ test.pl
>     test.pl:10: invalid variable interpolation at "$"
> 
> It seems xgettext considers some strings out of _(...) as being part of the
> msgid, and thus refuses dollars in the parameters following the format of
> printf.

Thanks for the detailed analysis. Your patch convincingly shows that this
is the case.

> I think the bug is caused by extract_balanced in gettext-tools/src/x-perl.c
> This function uses a state and is recusive, but the state is not
> propagated back to the caller. I made a test, which uses the following
> prototype (state is now a pointer):
> static bool extract_balanced (message_list_ty *mlp, int *state,
>                               token_type_ty delim,
>                               flag_context_ty outer_context,
>                               flag_context_list_iterator_ty context_iter,
>                               int arg, struct arglist_parser *argparser);
> 
> It works with the attached example, but I did not test it on something
> more complicated. Also, I was a little bit lost in the parser, so it may
> be completely wrong.

Your patch indeed fixes the problem and passes the testsuite. However, I'm
reluctant to apply it as is, because this makes the extract_balanced
function even harder to understand, and because there are apparently more
bugs in this area.

Is the following true? (I'm not a Perl programmer.)

   In Perl, parentheses around function arguments can be omitted.  Ambiguities
   are resolved as follows:
     - Some built-ins, such as 'abs', 'sqrt', 'sin', 'cos', ..., take exactly
       one argument:
         foo sin x, y  ==>  foo (sin (x), y)
     - Other identifiers, if immediately followed by an opening parenthesis,
       take exactly the specified arguments:
         foo bar (x), y  ==>  foo (bar (x), y)
         foo bar (x, y), z  ==>  foo (bar (x, y), z)
     - Other identifiers, if not immediately followed by an opening
       parenthesis, consume the entire remaining argument list:
         foo bar x, y  ==> foo (bar (x, y))

Also, would the attached test be a valid test in your opinion?
(gettext extracts its first argument, dgettext extracts its second argument.)

Bruno

==============================================================================
#! /bin/sh

# Test whether the right number of arguments are extracted.

tmpfiles=""
trap 'rm -fr $tmpfiles' 1 2 3 15

tmpfiles="$tmpfiles xg-pl-6.pl"
cat <<\EOPERL > xg-pl-6.pl
use strict;

print gettext "extracted1", "$shouldnotbeextracted";
print gettext ("extracted2"), "$shouldnotbeextracted";
print gettext ("extracted3")."$notextracted", "$shouldnotbeextracted";
print (gettext ("extracted4")), "$shouldnotbeextracted";

print foobar gettext "extracted5", "$shouldnotbeextracted";
print foobar gettext ("extracted6"), "$shouldnotbeextracted";
print foobar gettext ("extracted7")."$notextracted", "$shouldnotbeextracted";
print foobar (gettext ("extracted8")), "$shouldnotbeextracted";
print foobar (gettext "extracted9", "$shouldnotbeextracted");
print foobar (gettext ("extracted10"), "$shouldnotbeextracted");
print foobar (gettext ("extracted11")."$notextracted", "$shouldnotbeextracted");

print gettext foobar "$notextracted", "$shouldnotbeextracted";
print gettext foobar ("$notextracted"), "$shouldnotbeextracted";
print gettext foobar ("$notextracted")."$notextracted", "$shouldnotbeextracted";
print (gettext foobar ("$notextracted")), "$shouldnotbeextracted";
print gettext (foobar "$notextracted"), "$shouldnotbeextracted";
print gettext (foobar ("$notextracted")), "$shouldnotbeextracted";
print gettext (foobar ("$notextracted"))."$notextracted", 
"$shouldnotbeextracted";
print gettext (foobar ("$notextracted")."$notextracted"), 
"$shouldnotbeextracted";
print (gettext (foobar ("$notextracted"))), "$shouldnotbeextracted";

print dgettext sin 17, "extracted12";
print dgettext sin (17), "extracted13";
print dgettext foo 17, "$shouldnotbeextracted";
print dgettext foo (17), "extracted14";
EOPERL

tmpfiles="$tmpfiles xg-pl-6.pot"
: ${XGETTEXT=xgettext}
LC_MESSAGES=C LC_ALL= \
${XGETTEXT} --omit-header --no-location -o xg-pl-6.pot xg-pl-6.pl
test $? = 0 || { rm -fr $tmpfiles; exit 1; }

tmpfiles="$tmpfiles xg-pl-6.ok"
cat <<\EOF > xg-pl-6.ok
msgid "extracted1"
msgstr ""

msgid "extracted2"
msgstr ""

msgid "extracted3"
msgstr ""

msgid "extracted4"
msgstr ""

msgid "extracted5"
msgstr ""

msgid "extracted6"
msgstr ""

msgid "extracted7"
msgstr ""

msgid "extracted8"
msgstr ""

msgid "extracted9"
msgstr ""

msgid "extracted10"
msgstr ""

msgid "extracted11"
msgstr ""

msgid "extracted12"
msgstr ""

msgid "extracted13"
msgstr ""

msgid "extracted14"
msgstr ""
EOF

: ${DIFF=diff}
${DIFF} xg-pl-6.ok xg-pl-6.pot
result=$?

rm -fr $tmpfiles

exit $result