1#!/bin/sh
2
3# Test of Perl support.
4
5tmpfiles=""
6trap 'rm -fr $tmpfiles' 1 2 3 15
7
8tmpfiles="$tmpfiles xg-pl-1.pl"
9cat <<\EOF > xg-pl-1.pl
10use Locale::Messages qw (textdomain bindtextdomain gettext ngettext dngettext);
11
12textdomain "prog";
13bindtextdomain "prog", "./";
14
15s/foo/
16          # stress test for string extraction /xe;
17
18print _"'Your command, please?', asked the waiter.";
19
20printf ngettext ("a piece of cake", "%d pieces of cake", $n), $n;
21
22printf _"%s is replaced by %s.", "FF", "EUR";
23
24# Should be found.
25printf dngettext prog => ("one file deleted", "%d files deleted"), $n, $n;
26
27# Should not be found.
28printf dngettext ("prog"), ("one file created", "%d files created"), $n, $n;
29
30printf dngettext "prog", <<PERL, <<PERL;
31Singular
32PERL
33Plural
34PERL
35
36print <<PERL
37tied hash $__{   Bareword
38}
39tied hash $__->{"quoted string"}
40tied hash $__->{  "weird
41formatting"}
42PERL
43
44print $__  # Welcome
45   ->   # to the
46 { # Republic of
47 'Welcome to the Republic of Perl!' # 
48# Perl!
49}; 
50
51$! ? ?$__{"pattern match"}? : s  # This is no delimiter.
52{$__{substitution}}<$__-\>{"find me"}>;
53
54# No interpolation!
55m'$__{secret}';
56
57# Multiple here documents invoked from the same line.
58print gettext <<PERL; print gettext <<PERL;
59First here document.
60PERL
61Second here document.
62PERL
63
64# These are not invalid interpolations, because the dollar is backslashed.
65printf "%s\n", gettext "abc\$def";
66printf "%s\n", gettext "abc\\\$def";
67
68# These are not interpolations.
69printf "%s\n", gettext 'abc$defg';
70printf "%s\n", gettext 'abc\$defg';
71printf "%s\n", gettext 'abc\\$defg';
72printf "%s\n", gettext 'abc\\\$defg';
73
74# Two consecutive backslashes count as one inside single-quote strings.
75printf "%s\n", gettext 'ecs\tasy';
76printf "%s\n", gettext 'ecs\\tasy';
77printf "%s\n", gettext 'ecs\\\tasy';
78printf "%s\n", gettext 'ecs\\\\tasy';
79printf "%s\n", gettext 'ecs\\\\\tasy';
80printf "%s\n", gettext q(ecs\tasy);
81printf "%s\n", gettext q(ecs\\tasy);
82printf "%s\n", gettext q(ecs\\\tasy);
83printf "%s\n", gettext q(ecs\\\\tasy);
84printf "%s\n", gettext q(ecs\\\\\tasy);
85
86# Similarly, inside double-quote strings, two consecutive backslashes count
87# as one, but the last backslash of a sequence is combined with the following
88# character if possible.
89printf "%s\n", gettext "ecs\tasy";
90printf "%s\n", gettext "ecs\\tasy";
91printf "%s\n", gettext "ecs\\\tasy";
92printf "%s\n", gettext "ecs\\\\tasy";
93printf "%s\n", gettext "ecs\\\\\tasy";
94printf "%s\n", gettext qq(ecs\tasy);
95printf "%s\n", gettext qq(ecs\\tasy);
96printf "%s\n", gettext qq(ecs\\\tasy);
97printf "%s\n", gettext qq(ecs\\\\tasy);
98printf "%s\n", gettext qq(ecs\\\\\tasy);
99printf "%s\n", gettext "mari\huana";
100printf "%s\n", gettext "mari\\huana";
101printf "%s\n", gettext "mari\\\huana";
102printf "%s\n", gettext "mari\\\\huana";
103printf "%s\n", gettext "mari\\\\\huana";
104printf "%s\n", gettext qq(mari\huana);
105printf "%s\n", gettext qq(mari\\huana);
106printf "%s\n", gettext qq(mari\\\huana);
107printf "%s\n", gettext qq(mari\\\\huana);
108printf "%s\n", gettext qq(mari\\\\\huana);
109
110# Recognition of format strings.
111gettext "This is {only} a brace formatstring.";
112gettext "This is %s {mixed}.";
113gettext "This is only %c.";
114gettext "This is nothing at all.";
115gettext "And this is %l also no format at all.";
116
117# xgettext: no-perl-format, perl-brace-format
118gettext "The function '{func}' expects '%c' here.";
119
120# This is a contradictory case: The same string three times,
121# with different xgettext comments.
122# xgettext: perl-brace-format, no-perl-format
123gettext "Left as an %exercise to {maintainer}.";
124# xgettext: no-perl-brace-format, perl-format
125gettext "Left as an %exercise to {maintainer}.";
126# No xgettext comment this time.
127gettext "Left as an %exercise to {maintainer}.";
128
129# Dollars inside sub argument lists have no effect.
130sub testFunc($) { }
131=item TestBug1
132If you have gettext()'d foo bar test1'...
133=cut
134
135# Dollars inside sub argument lists have no effect.
136testFunc = sub ($) { }
137=item TestBug2
138If you have gettext()'d foo bar test2'...
139=cut
140
141# Dollars inside sub argument lists have no effect.
142sub testFunc($\$;*@) { }
143=item TestBug3
144If you have gettext()'d foo bar test3'...
145=cut
146
147__END__
148gettext "Discarded!";
149EOF
150
151tmpfiles="$tmpfiles xg-pl-1.po"
152: ${XGETTEXT=xgettext}
153${XGETTEXT} --omit-header -n \
154  -k_ --flag=_:1:pass-perl-format --flag=_:1:pass-perl-brace-format \
155  -k%__ --flag=%__:1:pass-perl-format --flag=%__:1:pass-perl-brace-format \
156  -k\$__ --flag=\$__:1:pass-perl-format --flag=\$__:1:pass-perl-brace-format \
157  xg-pl-1.pl -d xg-pl-1
158test $? = 0 || { rm -fr $tmpfiles; exit 1; }
159
160tmpfiles="$tmpfiles xg-pl-1.ok"
161cat <<\EOF > xg-pl-1.ok
162#: xg-pl-1.pl:9
163msgid "'Your command, please?', asked the waiter."
164msgstr ""
165
166#: xg-pl-1.pl:11
167#, perl-format
168msgid "a piece of cake"
169msgid_plural "%d pieces of cake"
170msgstr[0] ""
171msgstr[1] ""
172
173#: xg-pl-1.pl:13
174#, perl-format
175msgid "%s is replaced by %s."
176msgstr ""
177
178#: xg-pl-1.pl:16
179#, perl-format
180msgid "one file deleted"
181msgid_plural "%d files deleted"
182msgstr[0] ""
183msgstr[1] ""
184
185#: xg-pl-1.pl:22
186#, perl-format
187msgid "Singular\n"
188msgid_plural "Plural\n"
189msgstr[0] ""
190msgstr[1] ""
191
192#: xg-pl-1.pl:28
193msgid "Bareword"
194msgstr ""
195
196#: xg-pl-1.pl:30
197msgid "quoted string"
198msgstr ""
199
200#: xg-pl-1.pl:31
201msgid ""
202"weird\n"
203"formatting"
204msgstr ""
205
206#: xg-pl-1.pl:38
207msgid "Welcome to the Republic of Perl!"
208msgstr ""
209
210#: xg-pl-1.pl:42
211msgid "pattern match"
212msgstr ""
213
214#: xg-pl-1.pl:43
215msgid "substitution"
216msgstr ""
217
218#: xg-pl-1.pl:43
219msgid "find me"
220msgstr ""
221
222#: xg-pl-1.pl:50
223msgid "First here document.\n"
224msgstr ""
225
226#: xg-pl-1.pl:52
227msgid "Second here document.\n"
228msgstr ""
229
230#: xg-pl-1.pl:56
231msgid "abc$def"
232msgstr ""
233
234#: xg-pl-1.pl:57
235msgid "abc\\$def"
236msgstr ""
237
238#: xg-pl-1.pl:60
239msgid "abc$defg"
240msgstr ""
241
242#: xg-pl-1.pl:61 xg-pl-1.pl:62
243msgid "abc\\$defg"
244msgstr ""
245
246#: xg-pl-1.pl:63
247msgid "abc\\\\$defg"
248msgstr ""
249
250#: xg-pl-1.pl:66 xg-pl-1.pl:67 xg-pl-1.pl:71 xg-pl-1.pl:72 xg-pl-1.pl:81
251#: xg-pl-1.pl:86
252msgid "ecs\\tasy"
253msgstr ""
254
255#: xg-pl-1.pl:68 xg-pl-1.pl:69 xg-pl-1.pl:73 xg-pl-1.pl:74 xg-pl-1.pl:83
256#: xg-pl-1.pl:88
257msgid "ecs\\\\tasy"
258msgstr ""
259
260#: xg-pl-1.pl:70 xg-pl-1.pl:75
261msgid "ecs\\\\\\tasy"
262msgstr ""
263
264#: xg-pl-1.pl:80 xg-pl-1.pl:85
265msgid "ecs\tasy"
266msgstr ""
267
268#: xg-pl-1.pl:82 xg-pl-1.pl:87
269msgid "ecs\\\tasy"
270msgstr ""
271
272#: xg-pl-1.pl:84 xg-pl-1.pl:89
273msgid "ecs\\\\\tasy"
274msgstr ""
275
276#: xg-pl-1.pl:90 xg-pl-1.pl:95
277msgid "marihuana"
278msgstr ""
279
280#: xg-pl-1.pl:91 xg-pl-1.pl:92 xg-pl-1.pl:96 xg-pl-1.pl:97
281msgid "mari\\huana"
282msgstr ""
283
284#: xg-pl-1.pl:93 xg-pl-1.pl:94 xg-pl-1.pl:98 xg-pl-1.pl:99
285msgid "mari\\\\huana"
286msgstr ""
287
288#: xg-pl-1.pl:102
289#, perl-brace-format
290msgid "This is {only} a brace formatstring."
291msgstr ""
292
293#: xg-pl-1.pl:103
294#, perl-format, perl-brace-format
295msgid "This is %s {mixed}."
296msgstr ""
297
298#: xg-pl-1.pl:104
299#, perl-format
300msgid "This is only %c."
301msgstr ""
302
303#: xg-pl-1.pl:105
304msgid "This is nothing at all."
305msgstr ""
306
307#: xg-pl-1.pl:106
308msgid "And this is %l also no format at all."
309msgstr ""
310
311#: xg-pl-1.pl:109
312#, no-perl-format, perl-brace-format
313msgid "The function '{func}' expects '%c' here."
314msgstr ""
315
316#: xg-pl-1.pl:114 xg-pl-1.pl:116 xg-pl-1.pl:118
317#, perl-format, no-perl-brace-format
318msgid "Left as an %exercise to {maintainer}."
319msgstr ""
320EOF
321
322: ${DIFF=diff}
323${DIFF} xg-pl-1.ok xg-pl-1.po
324result=$?
325
326rm -fr $tmpfiles
327
328exit $result
329