1 2#sub Locale::Maketext::DEBUG () {10} 3use Locale::Maketext; 4 5use Test; 6BEGIN { plan tests => 26 }; 7print "#\n# Testing tight insertion of super-ordinate language tags...\n#\n"; 8 9my @in = grep m/\S/, split /[\n\r]/, q{ 10 NIX => NIX 11 sv => sv 12 en => en 13 hai => hai 14 15 pt-br => pt-br pt 16 pt-br fr => pt-br pt fr 17 pt-br fr pt => pt-br fr pt 18 19 pt-br fr pt de => pt-br fr pt de 20 de pt-br fr pt => de pt-br fr pt 21 de pt-br fr => de pt-br pt fr 22 hai pt-br fr => hai pt-br pt fr 23 24 # Now test multi-part complicateds: 25 pt-br-janeiro => pt-br-janeiro pt-br pt 26 pt-br-janeiro fr => pt-br-janeiro pt-br pt fr 27 pt-br-janeiro de fr => pt-br-janeiro pt-br pt de fr 28 pt-br-janeiro de pt fr => pt-br-janeiro pt-br de pt fr 29 30 pt-br-janeiro pt-br-saopaolo => pt-br-janeiro pt-br pt pt-br-saopaolo 31 pt-br-janeiro fr pt-br-saopaolo => pt-br-janeiro pt-br pt fr pt-br-saopaolo 32 pt-br-janeiro de pt-br-saopaolo fr => pt-br-janeiro pt-br pt de pt-br-saopaolo fr 33 pt-br-janeiro de pt-br fr pt-br-saopaolo => pt-br-janeiro de pt-br pt fr pt-br-saopaolo 34 35 pt-br de en fr pt-br-janeiro => pt-br pt de en fr pt-br-janeiro 36 pt-br de en fr => pt-br pt de en fr 37 38 ja pt-br-janeiro fr => ja pt-br-janeiro pt-br pt fr 39 ja pt-br-janeiro de fr => ja pt-br-janeiro pt-br pt de fr 40 ja pt-br-janeiro de pt fr => ja pt-br-janeiro pt-br de pt fr 41 42 pt-br-janeiro de pt-br fr => pt-br-janeiro de pt-br pt fr 43# an odd case, since we don't filter for uniqueness in this sub 44 45}; 46 47sub uniq { my %seen; return grep(!($seen{$_}++), @_); } 48 49foreach my $in (@in) { 50 $in =~ s/^\s+//s; 51 $in =~ s/\s+$//s; 52 $in =~ s/#.+//s; 53 next unless $in =~ m/\S/; 54 55 my(@in, @should); 56 { 57 die "What kind of line is <$in>?!" 58 unless $in =~ m/^(.+)=>(.+)$/s; 59 60 my($i,$s) = ($1, $2); 61 @in = ($i =~ m/(\S+)/g); 62 @should = ($s =~ m/(\S+)/g); 63 #print "{@in}{@should}\n"; 64 } 65 my @out = uniq( Locale::Maketext->_add_supers( 66 ("@in" eq 'NIX') ? () : @in 67 ) ); 68 #print "O: ", join(' ', map "<$_>", @out), "\n"; 69 @out = 'NIX' unless @out; 70 71 72 if( @out == @should 73 and lc( join "\e", @out ) eq lc( join "\e", @should ) 74 ) { 75 print "# Happily got [@out] from [$in]\n"; 76 ok 1; 77 } else { 78 ok 0; 79 print "#!!Got: [@out]\n", 80 "#!! but wanted: [@should]\n", 81 "#!! from \"$in\"\n#\n"; 82 } 83} 84 85print "#\n#\n# Bye-bye!\n"; 86ok 1; 87 88