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