1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
#!/usr/bin/perl -w
use strict;
my ($numtests, $loaded);
BEGIN { $numtests = 76; $| = 1; print "1..$numtests\n"; } # FIXME
END {print "not ok 1\n" unless $loaded;}
use Lingua::Preferred qw(which_lang acceptable_lang);
$loaded = 1;
print "ok 1\n";
use Data::Dumper;
my $tests_done = 1;
sub check_which_lang( $$$ ) {
my ($want, $avail, $ans) = @_;
my $got = Dumper(which_lang($want, $avail));
if ($got ne Dumper($ans)) {
warn "wanted: @$want\navailable: @$avail\nexpected: $ans\ngot: $got";
print 'not ';
}
print 'ok ', ++$tests_done, "\n";
}
check_which_lang [ ], [ 'en' ], 'en';
check_which_lang [ ], [ undef ], undef;
check_which_lang [ 'fr' ], [ 'en' ], 'en';
check_which_lang [ 'fr' ], [ 'en', 'fr' ], 'fr';
check_which_lang [ 'fr' ], [ 'en', 'fr_FR' ], 'fr_FR';
check_which_lang [ 'fr' ], [ 'en', 'fr_FR', 'fr' ], 'fr';
check_which_lang [ 'fr' ], [ undef ], undef;
check_which_lang [ 'fr', 'en' ], [ 'fr' ], 'fr';
check_which_lang [ 'fr', 'en' ], [ 'en' ], 'en';
check_which_lang [ 'fr', 'en' ], [ 'de' ], 'de';
check_which_lang [ 'fr', 'en' ], [ 'de', 'it' ], 'de';
check_which_lang [ 'fr', 'en' ], [ undef ], undef;
check_which_lang [ 'en_GB' ], [ 'en' ], 'en';
check_which_lang [ 'en_GB' ], [ 'fr' ], 'fr';
check_which_lang [ 'en_GB' ], [ undef ], undef;
check_which_lang [ 'en_GB' ], [ 'en_US' ], 'en_US';
check_which_lang [ 'en_GB' ], [ 'en_US', 'en_IT' ], 'en_US';
check_which_lang [ 'en_GB' ], [ 'en_US', 'en' ], 'en';
check_which_lang [ 'en_GB' ], [ 'en_US', 'en', 'en_GB' ], 'en_GB';
check_which_lang [ 'en', 'en_GB' ], [ 'en_US' ], 'en_US';
check_which_lang [ 'en', 'en_GB' ], [ 'en_IT', 'en_GB' ], 'en_GB';
check_which_lang [ 'en', 'en_GB' ], [ 'en', 'en_GB' ], 'en';
check_which_lang [ 'en_GB', 'en' ], [ 'en', 'en_GB' ], 'en_GB';
check_which_lang [ 'de', 'de_*', 'de_CH' ], [ 'fr' ], 'fr';
check_which_lang [ 'de', 'de_*', 'de_CH' ], [ 'de_CH' ], 'de_CH';
check_which_lang [ 'de', 'de_*', 'de_CH' ], [ 'de_CH', 'de_DE' ], 'de_DE';
check_which_lang [ 'de', 'de_*', 'fr', 'de_CH' ], [ 'de_CH', 'fr' ], 'fr';
# C matches anything, but it need not be first in the list
check_which_lang [ 'C', ], [ 'en' ], 'en';
check_which_lang [ 'C', ], [ undef ], undef;
check_which_lang [ 'en', 'C', ], [ 'en' ], 'en';
check_which_lang [ 'C', 'en', ], [ 'en' ], 'en';
check_which_lang [ 'C' ], [ 'en', 'fr' ], 'en';
check_which_lang [ 'C', 'fr' ], [ 'en', 'fr' ], 'en';
check_which_lang [ 'fr', 'C' ], [ 'en', 'fr' ], 'fr';
# The following are probably not something you'd actually use
check_which_lang [ 'en_*' ], [ 'en_GB', 'fr' ], 'en_GB';
# N.B. en_* implies en_IE, en_CA etc. but not en
check_which_lang [ 'en_*' ], [ 'fr', 'en' ], 'fr';
check_which_lang [ 'en_*' ], [ undef ], undef;
check_which_lang [ 'de_*', 'de_CH' ], [ 'de_CH', 'de', 'de_DE' ], 'de_DE';
check_which_lang [ 'de', 'fr', 'de_*', 'de_CH' ], [ 'de_CH', 'de_AT', 'fr' ], 'fr';
sub check_acceptable_lang( $$$ ) {
my ($want, $l, $ans) = @_;
my $got = acceptable_lang($want, $l);
if ($got != $ans) {
warn "wanted: @$want\nlang: $l\nexpected: $ans\ngot: $got";
print 'not ';
}
print 'ok ', ++$tests_done, "\n";
}
check_acceptable_lang [ ], 'en', 0;
check_acceptable_lang [ 'fr' ], 'en', 0;
check_acceptable_lang [ 'fr' ], 'en_ZA', 0;
check_acceptable_lang [ 'fr' ], 'fr', 1;
check_acceptable_lang [ 'fr' ], 'fr_FR', 1;
check_acceptable_lang [ 'fr', 'en' ], 'fr', 1;
check_acceptable_lang [ 'fr', 'en' ], 'en', 1;
check_acceptable_lang [ 'fr', 'en' ], 'de', 0;
check_acceptable_lang [ 'fr', 'en' ], 'fr_FR', 1;
check_acceptable_lang [ 'fr', 'en' ], 'en_FR', 1; # why not?
check_acceptable_lang [ 'fr', 'en' ], 'it_CH', 0;
check_acceptable_lang [ 'en_GB' ], 'en', 1;
check_acceptable_lang [ 'en_GB' ], 'en_GB', 1;
check_acceptable_lang [ 'en_GB' ], 'en_CA', 1;
check_acceptable_lang [ 'en_GB' ], 'nl', 0;
check_acceptable_lang [ 'en_GB' ], 'nl_NL', 0;
check_acceptable_lang [ 'en', 'en_GB' ], 'en', 1;
check_acceptable_lang [ 'en', 'en_GB' ], 'en_GB', 1;
check_acceptable_lang [ 'en', 'en_GB' ], 'en_CA', 1;
check_acceptable_lang [ 'en', 'en_GB' ], 'nl', 0;
check_acceptable_lang [ 'en', 'en_GB' ], 'nl_NL', 0;
check_acceptable_lang [ 'en_IE', 'en_US' ], 'en', 1;
check_acceptable_lang [ 'en_IE', 'en_US' ], 'en_GB', 1;
check_acceptable_lang [ 'en_IE', 'en_US' ], 'en_CA', 1;
check_acceptable_lang [ 'en_IE', 'en_US' ], 'nl', 0;
check_acceptable_lang [ 'en_IE', 'en_US' ], 'nl_NL', 0;
check_acceptable_lang [ 'de', 'de_*', 'de_CH' ], 'fr', 0;
check_acceptable_lang [ 'de', 'de_*', 'de_CH' ], 'de', 1;
check_acceptable_lang [ 'de', 'de_*', 'de_CH' ], 'de_DE', 1;
check_acceptable_lang [ 'de', 'de_*', 'de_CH' ], 'de_CH', 1;
# The following are probably not something you'd actually use
check_acceptable_lang [ 'en_*' ], 'en_GB', 1;
check_acceptable_lang [ 'en_*' ], 'it', 0;
check_acceptable_lang [ 'en_*' ], 'en', 1;
check_acceptable_lang [ 'de', 'fr', 'de_*', 'de_CH' ], 'fr', 1;
check_acceptable_lang [ 'de', 'fr', 'de_*', 'de_CH' ], 'nl', 0;
check_acceptable_lang [ 'de', 'fr', 'de_*', 'de_CH' ], 'de_CH', 1;
if ($tests_done != $numtests) {
die "expected to run $numtests tests, but ran $tests_done\n";
}
__END__
# Stuff for randomly generating test cases. I didn't really use this.
my @l = qw(en en_GB en_US de de_DE de_AT de_CH fr fr_FR fr_CA it it_IT);
my @l2 = qw(en_* fr_* de_* it_*);
sub randomize(@) {
my @r;
push @r, splice(@_, (rand @_), 1) while @_;
@r;
}
sub random_prefix(@) { @_[0 .. (rand @_)] }
sub random_subset(@) { randomize (random_prefix @_) }
for (;;) {
my @avail = random_subset @l;
my @want = random_subset (@l, @l2);
my $which = which_lang(\@want, \@avail);
print "which_lang([ qw(@want) ], [ qw(@avail) ]) is $which\n\n";
}
|
