-
-require 5;
-# Time-stamp: "2004-03-30 17:02:59 AST"
+use strict;
# Summary of, well, things.
-use Test;
-BEGIN {plan tests => 2};
-
-ok 1;
+use Test::More tests => 4;
-use I18N::LangTags;
-use I18N::LangTags::List;
-use I18N::LangTags::Detect;
+BEGIN {
+ use_ok('I18N::LangTags');
+ use_ok('I18N::LangTags::List');
+ use_ok('I18N::LangTags::Detect');
+}
#chdir "t" if -e "t";
next if $this eq 'main'; # %main:: is %::
#print "Peeking at $this => ${$this . '::VERSION'}\n";
-
+
+ no strict 'refs';
if(defined ${$this . '::VERSION'} ) {
$v{$this} = ${$this . '::VERSION'}
} elsif(
push @out, " Modules in memory:\n";
delete @v{'', '[none]'};
foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
- $indent = ' ' x (2 + ($p =~ tr/:/:/));
+ my $indent = ' ' x (2 + ($p =~ tr/:/:/));
push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
}
push @out, sprintf "[at %s (local) / %s (GMT)]\n",
print "# [$x] = [", $INC{$x} || '', "]\n";
}
-ok 1;
-
+pass('done');
-
-require 5;
- # Time-stamp: "2004-03-30 17:52:14 AST"
use strict;
-use Test;
-BEGIN { plan tests => 64 };
-BEGIN { ok 1 }
-use I18N::LangTags (':ALL');
+use Test::More tests => 64;
+BEGIN {use_ok('I18N::LangTags', ':ALL');}
-print "# Perl v$], I18N::LangTags v$I18N::LangTags::VERSION\n";
+note("Perl v$], I18N::LangTags v$I18N::LangTags::VERSION");
-ok !is_language_tag('');
-ok is_language_tag('fr');
-ok is_language_tag('fr-ca');
-ok is_language_tag('fr-CA');
-ok !is_language_tag('fr-CA-');
-ok !is_language_tag('fr_CA');
-ok is_language_tag('fr-ca-joual');
-ok !is_language_tag('frca');
-ok is_language_tag('nav'); # (not actual tag)
-ok is_language_tag('nav-shiprock'); # (not actual tag)
-ok !is_language_tag('nav-ceremonial'); # subtag too long
-ok !is_language_tag('x');
-ok !is_language_tag('i');
-ok is_language_tag('i-borg'); # NB: fictitious tag
-ok is_language_tag('x-borg');
-ok is_language_tag('x-borg-prot5123');
-ok same_language_tag('x-borg-prot5123', 'i-BORG-Prot5123' );
-ok !same_language_tag('en', 'en-us' );
+foreach (['', 0],
+ ['fr', 1],
+ ['fr-ca', 1],
+ ['fr-CA', 1],
+ ['fr-CA-', 0],
+ ['fr_CA', 0],
+ ['fr-ca-joal', 1],
+ ['frca', 0],
+ ['nav', 1, 'not actual tag'],
+ ['nav-shiprock', 1, 'not actual tag'],
+ ['nav-ceremonial', 0, 'subtag too long'],
+ ['x', 0],
+ ['i', 0],
+ ['i-borg', 1, 'fictitious tag'],
+ ['x-borg', 1],
+ ['x-borg-prot5123', 1],
+ ) {
+ my ($tag, $expect, $note) = @$_;
+ $note = $note ? " # $note" : '';
+ is(is_language_tag($tag), $expect, "is_language_tag('$tag')$note");
+}
+is(same_language_tag('x-borg-prot5123', 'i-BORG-Prot5123'), 1);
+is(same_language_tag('en', 'en-us'), 0);
-ok 0 == similarity_language_tag('en-ca', 'fr-ca');
-ok 1 == similarity_language_tag('en-ca', 'en-us');
-ok 2 == similarity_language_tag('en-us-southern', 'en-us-western');
-ok 2 == similarity_language_tag('en-us-southern', 'en-us');
+is(similarity_language_tag('en-ca', 'fr-ca'), 0);
+is(similarity_language_tag('en-ca', 'en-us'), 1);
+is(similarity_language_tag('en-us-southern', 'en-us-western'), 2);
+is(similarity_language_tag('en-us-southern', 'en-us'), 2);
ok grep $_ eq 'hi', panic_languages('kok');
ok grep $_ eq 'en', panic_languages('x-woozle-wuzzle');
ok grep $_ eq 'it', panic_languages('es');
-print "# Now the ::List tests...\n";
-print "# Perl v$], I18N::LangTags::List v$I18N::LangTags::List::VERSION\n";
+note("Now the ::List tests...");
+note("# Perl v$], I18N::LangTags::List v$I18N::LangTags::List::VERSION");
use I18N::LangTags::List;
foreach my $lt (qw(
cr-latin
)) {
my $name = I18N::LangTags::List::name($lt);
- if($name) {
- ok(1);
- print "# $lt -> $name\n";
- } else {
- ok(0);
- print "# Failed lookup on $lt\n";
- }
+ isnt($name, undef, "I18N::LangTags::List::name('$lt')");
}
-
-
-
-print "# So there!\n";
-
-
-require 5;
- # Time-stamp: "2003-10-10 17:37:34 ADT"
use strict;
-use Test;
-BEGIN { plan tests => 17 };
-BEGIN { ok 1 }
-use I18N::LangTags::List;
-
-print "# Perl v$], I18N::LangTags::List v$I18N::LangTags::List::VERSION\n";
-
-ok I18N::LangTags::List::name('fr'), 'French';
-ok I18N::LangTags::List::name('fr-fr');
-ok !I18N::LangTags::List::name('El Zorcho');
-ok !I18N::LangTags::List::name();
+use Test::More tests => 16;
+BEGIN {use_ok('I18N::LangTags::List');}
+note("Perl v$], I18N::LangTags::List v$I18N::LangTags::List::VERSION");
-ok !I18N::LangTags::List::is_decent();
-ok I18N::LangTags::List::is_decent('fr');
-ok I18N::LangTags::List::is_decent('fr-blorch');
-ok !I18N::LangTags::List::is_decent('El Zorcho');
-ok !I18N::LangTags::List::is_decent('sgn');
-ok I18N::LangTags::List::is_decent('sgn-us');
-ok !I18N::LangTags::List::is_decent('i');
-ok I18N::LangTags::List::is_decent('i-mingo');
-ok I18N::LangTags::List::is_decent('i-mingo-tom');
-ok !I18N::LangTags::List::is_decent('cel');
-ok I18N::LangTags::List::is_decent('cel-gaulish');
+is(I18N::LangTags::List::name('fr'), 'French');
+isnt(I18N::LangTags::List::name('fr-fr'), undef);
+is(I18N::LangTags::List::name('El Zorcho'), undef);
+is(I18N::LangTags::List::name(), undef);
-ok 1; # one for the road
+isnt(I18N::LangTags::List::is_decent(), undef);
+foreach(['fr', 2],
+ ['fr-blorch', 2],
+ ['El Zorcho', 0],
+ ['sgn', 0],
+ ['sgn-us', 2],
+ ['i', 0],
+ ['i-mingo', 2],
+ ['i-mingo-tom', 2],
+ ['cel', 0],
+ ['cel-gaulish', 2],
+ ) {
+ my ($tag, $expect) = @$_;
+ is(I18N::LangTags::List::is_decent($tag), $expect,
+ "I18N::LangTags::List::is_decent('$tag')");
+}
-
-# Time-stamp: "2004-06-17 23:06:22 PDT"
+use strict;
use I18N::LangTags::Detect;
-use Test;
-BEGIN { plan tests => 87 };
+use Test::More;
my @in = grep m/\S/, split /\n/, q{
[ NIX ] NIX
};
+plan(tests => 2 * @in);
foreach my $in (@in) {
$in =~ s/^\s*\[([^\]]+)\]\s*//s or die "Bad input: $in";
my @should = do { my $x = $1; $x =~ m/(\S+)/g };
local $ENV{'HTTP_ACCEPT_LANGUAGE'};
- foreach my $modus (
- sub {
+ foreach (
+ ['arg', sub {
print "# Testing with arg...\n";
$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'PLORK';
return $_[0];
- },
- sub {
+ }],
+ ['HTTP_ACCEPT_LANGUAGE', sub {
print "# Testing wath HTTP_ACCEPT_LANGUAGE...\n";
$ENV{'HTTP_ACCEPT_LANGUAGE'} = $_[0];
return();
- },
- ) {
+ }],
+ ) {
+ my ($type, $modus) = @$_;
my @args = &$modus($in);
# ////////////////////////////////////////////////////
my @out = I18N::LangTags::Detect->http_accept_langs(@args);
# \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
- if(
- @out == @should
- and lc( join "\e", @out ) eq lc( join "\e", @should )
- ) {
- print "# Happily got [@out] from [$in]\n";
- ok 1;
- } else {
- ok 0;
- print "#Got: [@out]\n",
- "# but wanted: [@should]\n",
- "# < \"$in\"\n#\n";
- }
+ is_deeply(\@out, \@should, "Testing [$in] with $type");
}
}
-
-print "#\n#\n# Bye-bye!\n";
-ok 1;
-
-require 5;
- # Time-stamp: "2004-10-06 23:07:06 ADT"
use strict;
-use Test;
-BEGIN { plan tests => 22 };
-BEGIN { ok 1 }
-use I18N::LangTags (':ALL');
+use Test::More tests => 21;
+BEGIN {use_ok('I18N::LangTags', ':ALL')};
-print "# Perl v$], I18N::LangTags v$I18N::LangTags::VERSION\n";
-print "# Loaded from ", $INC{'I18N/LangTags.pm'} || "??", "\n";
+note("Perl v$], I18N::LangTags v$I18N::LangTags::VERSION");
+note("Loaded from " . ($INC{'I18N/LangTags.pm'} || "??"));
-ok lc locale2language_tag('en'), 'en';
-ok lc locale2language_tag('en_US'), 'en-us';
-ok lc locale2language_tag('en_US.ISO8859-1'), 'en-us';
-ok lc(locale2language_tag('C')||''), '';
-ok lc(locale2language_tag('POSIX')||''), '';
+foreach ('C', 'POSIX') {
+ # It seems that the acceptable result is either '' or undef
+ my $tag = locale2language_tag($_);
+ is($tag, defined $tag ? '' : undef, "locale2language_tag('$_')");
+}
-
-ok lc locale2language_tag('eu_mt'), 'eu-mt';
-ok lc locale2language_tag('eu'), 'eu';
-ok lc locale2language_tag('it'), 'it';
-ok lc locale2language_tag('it_IT'), 'it-it';
-ok lc locale2language_tag('it_IT.utf8'), 'it-it';
-ok lc locale2language_tag('it_IT.utf8@euro'), 'it-it';
-ok lc locale2language_tag('it_IT@euro'), 'it-it';
-
-
-ok lc locale2language_tag('zh_CN.gb18030'), 'zh-cn';
-ok lc locale2language_tag('zh_CN.gbk'), 'zh-cn';
-ok lc locale2language_tag('zh_CN.utf8'), 'zh-cn';
-ok lc locale2language_tag('zh_HK'), 'zh-hk';
-ok lc locale2language_tag('zh_HK.utf8'), 'zh-hk';
-ok lc locale2language_tag('zh_TW'), 'zh-tw';
-ok lc locale2language_tag('zh_TW.euctw'), 'zh-tw';
-ok lc locale2language_tag('zh_TW.utf8'), 'zh-tw';
-
-print "# So there!\n";
-ok 1;
+foreach (['en', 'en'],
+ ['en_US', 'en-us'],
+ ['en_US.ISO8859-1', 'en-us'],
+ ['eu_mt', 'eu-mt'],
+ ['eu', 'eu'],
+ ['it', 'it'],
+ ['it_IT', 'it-it'],
+ ['it_IT.utf8', 'it-it'],
+ ['it_IT.utf8@euro', 'it-it'],
+ ['it_IT@euro', 'it-it'],
+ ['zh_CN.gb18030', 'zh-cn'],
+ ['zh_CN.gbk', 'zh-cn'],
+ ['zh_CN.utf8', 'zh-cn'],
+ ['zh_HK', 'zh-hk'],
+ ['zh_HK.utf8', 'zh-hk'],
+ ['zh_TW', 'zh-tw'],
+ ['zh_TW.euctw', 'zh-tw'],
+ ['zh_TW.utf8', 'zh-tw'],
+ ) {
+ my ($tag, $expect) = @$_;
+ is(lc locale2language_tag($tag), $expect,
+ "locale2language_tag('$tag')");
+}
+use strict;
-# Time-stamp: "2004-03-30 17:46:17 AST"
+use Test::More tests => 26;
+note('Testing normal (tight) insertion of super-ordinate language tags...');
-use Test;
-BEGIN { plan tests => 26 };
-print "#\n# Testing normal (tight) insertion of super-ordinate language tags...\n#\n";
-
-use I18N::LangTags qw(implicate_supers);
+BEGIN {use_ok('I18N::LangTags', 'implicate_supers');}
my @in = grep m/\S/, split /[\n\r]/, q{
NIX => NIX
};
-sub uniq { my %seen; return grep(!($seen{$_}++), @_); }
-
foreach my $in (@in) {
$in =~ s/^\s+//s;
$in =~ s/\s+$//s;
my($i,$s) = ($1, $2);
@in = ($i =~ m/(\S+)/g);
@should = ($s =~ m/(\S+)/g);
- #print "{@in}{@should}\n";
}
my @out = implicate_supers(
("@in" eq 'NIX') ? () : @in
);
- #print "O: ", join(' ', map "<$_>", @out), "\n";
@out = 'NIX' unless @out;
-
- if( @out == @should
- and lc( join "\e", @out ) eq lc( join "\e", @should )
- ) {
- print "# Happily got [@out] from [$in]\n";
- ok 1;
- } else {
- ok 0;
- print "#!!Got: [@out]\n",
- "#!! but wanted: [@should]\n",
- "#!! from \"$in\"\n#\n";
- }
+ is_deeply(\@out, \@should, "implicate_supers for [$in]");
}
-
-print "#\n#\n# Bye-bye!\n";
-ok 1;
-
-
-# Time-stamp: "2004-03-30 17:49:58 AST"
+use strict;
#sub I18N::LangTags::Detect::DEBUG () {10}
-use I18N::LangTags qw(implicate_supers_strictly);
-use Test;
-BEGIN { plan tests => 19 };
+use Test::More tests => 19;
+BEGIN {use_ok('I18N::LangTags', 'implicate_supers_strictly');}
-print "#\n# Testing strict (non-tight) insertion of super-ordinate language tags...\n#\n";
+note('Testing strict (non-tight) insertion of super-ordinate language tags');
my @in = grep m/\S/, split /[\n\r]/, q{
NIX => NIX
my($i,$s) = ($1, $2);
@in = ($i =~ m/(\S+)/g);
@should = ($s =~ m/(\S+)/g);
- #print "{@in}{@should}\n";
}
my @out = I18N::LangTags::implicate_supers_strictly(
("@in" eq 'NIX') ? () : @in
);
- #print "O: ", join(' ', map "<$_>", @out), "\n";
@out = 'NIX' unless @out;
-
- if( @out == @should
- and lc( join "\e", @out ) eq lc( join "\e", @should )
- ) {
- print "# Happily got [@out] from [$in]\n";
- ok 1;
- } else {
- ok 0;
- print "#!!Got: [@out]\n",
- "#!! but wanted: [@should]\n",
- "#!! from \"$in\"\n#\n";
- }
+ is_deeply(\@out, \@should, "implicate_supers_strictly for [$in]");
}
-
-print "#\n#\n# Bye-bye!\n";
-ok 1;
-
+use strict;
+use Test::More tests => 17;
+BEGIN {use_ok('I18N::LangTags::Detect', 1.01);}
-require 5;
-use Test;
-# Time-stamp: "2004-07-01 14:33:50 ADT"
-BEGIN { plan tests => 18; }
-use I18N::LangTags::Detect 1.01;
-print "# Hi there...\n";
-ok 1;
+note("Using I18N::LangTags::Detect v$I18N::LangTags::Detect::VERSION");
-print "# Using I18N::LangTags::Detect v$I18N::LangTags::Detect::VERSION\n";
-
-print "# Make sure we can assign to ENV entries\n",
- "# (Otherwise we can't run the subsequent tests)...\n";
-$ENV{'MYORP'} = 'Zing'; ok $ENV{'MYORP'}, 'Zing';
-$ENV{'SWUZ'} = 'KLORTHO HOOBOY'; ok $ENV{'SWUZ'}, 'KLORTHO HOOBOY';
+note("Make sure we can assign to ENV entries");
+note("Otherwise we can't run the subsequent tests");
+$ENV{'MYORP'} = 'Zing'; is($ENV{'MYORP'}, 'Zing');
+$ENV{'SWUZ'} = 'KLORTHO HOOBOY'; is($ENV{'SWUZ'}, 'KLORTHO HOOBOY');
delete $ENV{'MYORP'};
delete $ENV{'SWUZ'};
-sub j { "[" . join(' ', map "\"$_\"", @_) . "]" ;}
-
-sub show {
- print "# (Seeing {", join(' ',
- map(qq{<$_>}, @_)), "} at line ", (caller)[2], ")\n";
- printenv();
- return $_[0] || '';
-}
sub printenv {
print "# ENV:\n";
foreach my $k (sort keys %ENV) {
$ENV{'IGNORE_WIN32_LOCALE'} = 1; # a hack, just for testing's sake.
+foreach my $test_var (qw (LANGUAGE LC_ALL LC_MESSAGES LANG)) {
+ $ENV{$_} = '' foreach qw(REQUEST_METHOD LANGUAGE LC_ALL LC_MESSAGES LANG);
+ $ENV{$test_var} = 'Eu-MT';
+ my $what = "I18N::LangTags::Detect::detect() for \$ENV{$test_var} = 'Eu-MT'";
+ printenv();
+ is(scalar I18N::LangTags::Detect::detect(), "eu-mt",
+ "scalar $what");
+ is_deeply([I18N::LangTags::Detect::detect()], ["eu-mt"], $what);
+}
-print "# Test LANGUAGE...\n";
-$ENV{'REQUEST_METHOD'} = '';
-$ENV{'LANGUAGE'} = 'Eu-MT';
-$ENV{'LC_ALL'} = '';
-$ENV{'LC_MESSAGES'} = '';
-$ENV{'LANG'} = '';
-ok show( scalar I18N::LangTags::Detect::detect()), "eu-mt";
-ok show( j I18N::LangTags::Detect::detect()), q{["eu-mt"]};
-
-
-print "# Test LC_ALL...\n";
-$ENV{'REQUEST_METHOD'} = '';
-$ENV{'LANGUAGE'} = '';
-$ENV{'LC_ALL'} = 'Eu-MT';
-$ENV{'LC_MESSAGES'} = '';
-$ENV{'LANG'} = '';
-
-ok show( scalar I18N::LangTags::Detect::detect()), "eu-mt";
-ok show( j I18N::LangTags::Detect::detect()), q{["eu-mt"]};
-
-print "# Test LC_MESSAGES...\n";
-$ENV{'REQUEST_METHOD'} = '';
-$ENV{'LANGUAGE'} = '';
-$ENV{'LC_ALL'} = '';
-$ENV{'LC_MESSAGES'} = 'Eu-MT';
-$ENV{'LANG'} = '';
-
-ok show( scalar I18N::LangTags::Detect::detect()), "eu-mt";
-ok show( j I18N::LangTags::Detect::detect()), q{["eu-mt"]};
-
-
-print "# Test LANG...\n";
-$ENV{'REQUEST_METHOD'} = '';
-$ENV{'LANGUAGE'} = '';
-$ENV{'LC_ALL'} = '';
-$ENV{'LC_MESSAGES'} = '';
-$ENV{'LANG'} = 'Eu_MT';
-
-ok show( scalar I18N::LangTags::Detect::detect()), "eu-mt";
-ok show( j I18N::LangTags::Detect::detect()), q{["eu-mt"]};
-
-
-
-
-print "# Test HTTP_ACCEPT_LANGUAGE...\n";
+note("Test HTTP_ACCEPT_LANGUAGE");
$ENV{'REQUEST_METHOD'} = 'GET';
-$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'eu-MT';
-ok show( scalar I18N::LangTags::Detect::detect()), "eu-mt";
-ok show( j I18N::LangTags::Detect::detect()), q{["eu-mt"]};
-
-
-$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'x-plorp, zaz, eu-MT, i-klung';
-ok show( scalar I18N::LangTags::Detect::detect()), "x-plorp";
-ok show( j I18N::LangTags::Detect::detect()), qq{["x-plorp" "i-plorp" "zaz" "eu-mt" "i-klung" "x-klung"]};
-
-$ENV{'HTTP_ACCEPT_LANGUAGE'} = 'x-plorp, zaz, eU-Mt, i-klung';
-ok show( scalar I18N::LangTags::Detect::detect()), "x-plorp";
-ok show( j I18N::LangTags::Detect::detect()), qq{["x-plorp" "i-plorp" "zaz" "eu-mt" "i-klung" "x-klung"]};
-
-
-
-
-print "# Byebye!\n";
-ok 1;
+foreach(['eu-MT', "eu-mt"],
+ ['x-plorp, zaz, eu-MT, i-klung',
+ 'x-plorp', 'i-plorp', 'zaz', 'eu-mt', 'i-klung', 'x-klung'],
+ ['x-plorp, zaz, eU-Mt, i-klung',
+ 'x-plorp', 'i-plorp', 'zaz', 'eu-mt', 'i-klung', 'x-klung'],
+ ) {
+ my ($val, @expect) = @$_;
+ my $what = "I18N::LangTags::Detect::detect() for \$ENV{HTTP_ACCEPT_LANGUAGE} = '$val'";
+ $ENV{'HTTP_ACCEPT_LANGUAGE'} = $val;
+ printenv();
+ is(scalar I18N::LangTags::Detect::detect(), $expect[0], "scalar $what");
+ is_deeply([I18N::LangTags::Detect::detect()], \@expect, $what);
+}
projects / platform / upstream / perl.git / commitdiff