use strict;
use warnings;
use utf8;
use File::Spec;
use Test::More;
use DateTime::Locale;
my @locale_ids = sort DateTime::Locale->ids();
my %locale_names = map { $_ => 1 } DateTime::Locale->names;
my %locale_ids = map { $_ => 1 } DateTime::Locale->ids;
plan tests =>
5 # starting
+ 1 # one test for root locale
+ ( ( @locale_ids - 1 ) * 21 ) # tests for each other local
+ 56 # check_root
+ 24 # check_en
+ 66 # check_en_GB
+ 23 # check_en_US
+ 11 # check_es_ES
+ 5 # check_en_US_POSIX
+ 2 # check_af
+ 3 # check_C_locales
+ 9 # check_DT_Lang
;
{
ok( @locale_ids >= 240, 'Coverage looks complete' );
ok( $locale_names{English}, "Locale name 'English' found" );
ok( $locale_ids{ar_JO}, "Locale id 'ar_JO' found" );
eval { DateTime::Locale->load('Does not exist') };
like( $@, qr/invalid/i,
'invalid locale name/id to load() causes an error' );
# this type of locale id should work
my $l = DateTime::Locale->load('en_US.LATIN-1');
is( $l->id, 'en_US', 'id is en_US' );
}
# testing the basics for all ids
{
for my $locale_id (@locale_ids) {
my $locale = eval { DateTime::Locale->load($locale_id) };
isa_ok( $locale, 'DateTime::Locale::Base' );
next if $locale_id eq 'root';
ok( $locale_ids{ $locale->id() },
"'$locale_id': Has a valid locale id" );
ok( length $locale->name(), "'$locale_id': Has a locale name" );
ok(
length $locale->native_name(),
"'$locale_id': Has a native locale name"
);
for my $test (
{
locale_method => 'month_format_wide',
count => 12,
}, {
locale_method => 'month_format_abbreviated',
count => 12,
}, {
locale_method => 'day_format_wide',
count => 7,
}, {
locale_method => 'day_format_abbreviated',
count => 7,
}, {
locale_method => 'quarter_format_wide',
count => 4,
}, {
locale_method => 'quarter_format_abbreviated',
count => 4,
}, {
locale_method => 'am_pm_abbreviated',
count => 2,
}, {
locale_method => 'era_wide',
count => 2,
}, {
locale_method => 'era_abbreviated',
count => 2,
},
) {
check_array( locale => $locale, %$test );
}
# We can't actually expect these to be unique.
is( scalar @{ $locale->day_format_narrow() }, 7,
'day_format_narrow() returns 7 items' );
is( scalar @{ $locale->month_format_narrow() }, 12,
'month_format_narrow() returns 12 items' );
is( scalar @{ $locale->day_stand_alone_narrow() }, 7,
'day_stand_alone_narrow() returns 7 items' );
is( scalar @{ $locale->month_stand_alone_narrow() }, 12,
'month_stand_alone_narrow() returns 12 items' );
check_formats( $locale_id, $locale, 'date_formats', 'date_format' );
check_formats( $locale_id, $locale, 'time_formats', 'time_format' );
}
}
check_root();
check_en();
check_en_GB();
check_en_US();
check_es_ES();
check_en_US_POSIX();
check_af();
check_C_locales();
check_DT_Lang();
sub check_array {
my %test = @_;
my $locale_method = $test{locale_method};
my %unique = map { $_ => 1 } @{ $test{locale}->$locale_method() };
my $locale_id = $test{locale}->id();
TODO:
{
local $TODO
= 'The ii locale does not have unique abbreviated days for some reason'
if $test{locale}->id() =~ /^ii/
&& $locale_method eq 'day_format_abbreviated';
is(
keys %unique, $test{count},
qq{'$locale_id': '$locale_method' contains $test{count} unique items}
);
}
}
sub check_formats {
my ( $locale_id, $locale, $hash_func, $item_func ) = @_;
my %unique = map { $_ => 1 } values %{ $locale->$hash_func() };
ok( keys %unique >= 1,
"'$locale_id': '$hash_func' contains at least 1 unique item" );
foreach my $length (qw( full long medium short )) {
my $method = $item_func . q{_} . $length;
my $val = $locale->$method();
if ( defined $val ) {
delete $unique{$val};
}
else {
Test::More::diag("$locale_id returned undef for $method()");
}
}
is(
keys %unique, 0,
"'$locale_id': Data returned by '$hash_func' and '$item_func patterns' matches"
);
}
sub check_root {
my $locale = DateTime::Locale->load('root');
my %tests = (
day_format_wide => [qw( 2 3 4 5 6 7 1 )],
day_format_abbreviated => [qw( 2 3 4 5 6 7 1 )],
day_format_narrow => [qw( 2 3 4 5 6 7 1 )],
day_stand_alone_wide => [qw( 2 3 4 5 6 7 1 )],
day_stand_alone_abbreviated => [qw( 2 3 4 5 6 7 1 )],
day_stand_alone_narrow => [qw( 2 3 4 5 6 7 1 )],
month_format_wide => [qw( 1 2 3 4 5 6 7 8 9 10 11 12 )],
month_format_abbreviated => [qw( 1 2 3 4 5 6 7 8 9 10 11 12 )],
month_format_narrow => [qw( 1 2 3 4 5 6 7 8 9 10 11 12 )],
month_stand_alone_wide => [qw( 1 2 3 4 5 6 7 8 9 10 11 12 )],
month_stand_alone_abbreviated => [qw( 1 2 3 4 5 6 7 8 9 10 11 12 )],
month_stand_alone_narrow => [qw( 1 2 3 4 5 6 7 8 9 10 11 12 )],
quarter_format_wide => [qw( Q1 Q2 Q3 Q4 )],
quarter_format_abbreviated => [qw( Q1 Q2 Q3 Q4 )],
quarter_format_narrow => [qw( 1 2 3 4 )],
quarter_stand_alone_wide => [qw( Q1 Q2 Q3 Q4 )],
quarter_stand_alone_abbreviated => [qw( Q1 Q2 Q3 Q4 )],
quarter_stand_alone_narrow => [qw( 1 2 3 4 )],
era_wide => [qw( BCE CE )],
era_abbreviated => [qw( BCE CE )],
era_narrow => [qw( BCE CE )],
am_pm_abbreviated => [qw( AM PM )],
datetime_format_full => 'EEEE, y MMMM dd HH:mm:ss zzzz',
datetime_format_long => 'y MMMM d HH:mm:ss z',
datetime_format_medium => 'y MMM d HH:mm:ss',
datetime_format_short => 'yyyy-MM-dd HH:mm',
datetime_format_default => 'y MMM d HH:mm:ss',
glibc_datetime_format => '%a %b %e %H:%M:%S %Y',
glibc_date_format => '%m/%d/%y',
glibc_time_format => '%H:%M:%S',
first_day_of_week => 1,
prefers_24_hour_time => 1,
);
test_data( $locale, %tests );
my %formats = (
d => 'd',
EEEd => 'd EEE',
hm => 'h:mm a',
Hm => 'H:mm',
hms => 'h:mm:ss a',
Hms => 'H:mm:ss',
M => 'L',
Md => 'M-d',
MEd => 'E, M-d',
MMM => 'LLL',
MMMd => 'MMM d',
MMMEd => 'E MMM d',
MMMMd => 'MMMM d',
MMMMEd => 'E MMMM d',
ms => 'mm:ss',
y => 'y',
yM => 'y-M',
yMEd => 'EEE, y-M-d',
yMMM => 'y MMM',
yMMMEd => 'EEE, y MMM d',
yMMMM => 'y MMMM',
yQ => 'y Q',
yQQQ => 'y QQQ',
);
test_formats( $locale, %formats );
}
sub check_en {
my $locale = DateTime::Locale->load('en');
my %tests = (
en_data(),
name => 'English',
);
test_data( $locale, %tests );
}
sub check_en_GB {
my $locale = DateTime::Locale->load('en_GB');
my %tests = (
en_data(),
first_day_of_week => 7,
name => 'English United Kingdom',
native_name => 'English United Kingdom',
language => 'English',
native_language => 'English',
territory => 'United Kingdom',
native_territory => 'United Kingdom',
variant => undef,
native_variant => undef,
language_id => 'en',
territory_id => 'GB',
variant_id => undef,
glibc_datetime_format => '%a %d %b %Y %T %Z',
glibc_date_format => '%d/%m/%y',
glibc_time_format => '%T',
datetime_format_default => 'd MMM y HH:mm:ss',
);
test_data( $locale, %tests );
my %formats = (
Md => 'd/M',
MEd => 'E, d/M',
MMdd => 'dd/MM',
MMMEd => 'E d MMM',
MMMMd => 'd MMMM',
yMEd => 'EEE, d/M/yyyy',
yyMMM => 'MMM yy',
yyyyMM => 'MM/yyyy',
yyyyMMMM => 'MMMM y',
# from en
d => 'd',
EEEd => 'd EEE',
hm => 'h:mm a',
Hm => 'H:mm',
Hms => 'H:mm:ss',
M => 'L',
MMM => 'LLL',
MMMd => 'MMM d',
MMMMEd => 'E, MMMM d',
ms => 'mm:ss',
y => 'y',
yM => 'M/yyyy',
yMMM => 'MMM y',
yMMMEd => 'EEE, MMM d, y',
yMMMM => 'MMMM y',
yQ => 'Q yyyy',
yQQQ => 'QQQ y',
# from root
hms => 'h:mm:ss a',
);
test_formats( $locale, %formats );
}
sub check_en_US {
my $locale = DateTime::Locale->load('en_US');
my %tests = (
en_data(),
first_day_of_week => 7,
);
test_data( $locale, %tests );
}
sub en_data {
return (
day_format_wide =>
[qw( Monday Tuesday Wednesday Thursday Friday Saturday Sunday )],
day_format_abbreviated => [qw( Mon Tue Wed Thu Fri Sat Sun )],
day_format_narrow => [qw( M T W T F S S )],
day_stand_alone_wide =>
[qw( Monday Tuesday Wednesday Thursday Friday Saturday Sunday )],
day_stand_alone_abbreviated => [qw( Mon Tue Wed Thu Fri Sat Sun )],
day_stand_alone_narrow => [qw( M T W T F S S )],
month_format_wide => [
qw( January February March April May June
July August September October November December )
],
month_format_abbreviated =>
[qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec )],
month_format_narrow => [qw( J F M A M J J A S O N D )],
month_stand_alone_wide => [
qw( January February March April May June
July August September October November December )
],
month_stand_alone_abbreviated =>
[qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec )],
month_stand_alone_narrow => [qw( J F M A M J J A S O N D )],
quarter_format_wide =>
[ '1st quarter', '2nd quarter', '3rd quarter', '4th quarter' ],
quarter_format_abbreviated => [qw( Q1 Q2 Q3 Q4 )],
quarter_format_narrow => [qw( 1 2 3 4 )],
quarter_stand_alone_wide =>
[ '1st quarter', '2nd quarter', '3rd quarter', '4th quarter' ],
quarter_stand_alone_abbreviated => [qw( Q1 Q2 Q3 Q4 )],
quarter_stand_alone_narrow => [qw( 1 2 3 4 )],
era_wide => [ 'Before Christ', 'Anno Domini' ],
era_abbreviated => [qw( BC AD )],
era_narrow => [qw( B A )],
am_pm_abbreviated => [qw( AM PM )],
first_day_of_week => 1,
);
}
sub test_data {
my $locale = shift;
my %tests = @_;
for my $k ( sort keys %tests ) {
my $desc = "$k for " . $locale->id();
if ( ref $tests{$k} ) {
is_deeply( $locale->$k(), $tests{$k}, $desc );
}
else {
is( $locale->$k(), $tests{$k}, $desc );
}
}
}
sub test_formats {
my $locale = shift;
my %formats = @_;
for my $name ( keys %formats ) {
is(
$locale->format_for($name), $formats{$name},
"Format for $name with " . $locale->id()
);
}
is_deeply(
[ $locale->available_formats() ],
[ sort keys %formats ],
"Available formats for " . $locale->id() . " match what is expected"
);
}
sub check_es_ES {
my $locale = DateTime::Locale->load('es_ES');
is( $locale->name(), 'Spanish Spain', 'name()' );
is( $locale->native_name(), 'español España', 'native_name()' );
is( $locale->language(), 'Spanish', 'language()' );
is( $locale->native_language(), 'español', 'native_language()' );
is( $locale->territory(), 'Spain', 'territory()' );
is( $locale->native_territory(), 'España', 'native_territory()' );
is( $locale->variant(), undef, 'variant()' );
is( $locale->native_variant(), undef, 'native_variant()' );
is( $locale->language_id(), 'es', 'language_id()' );
is( $locale->territory_id(), 'ES', 'territory_id()' );
is( $locale->variant_id(), undef, 'variant_id()' );
}
sub check_af {
my $locale = DateTime::Locale->load('af');
is_deeply(
$locale->month_format_abbreviated(),
[qw( Jan Feb Mar Apr Mei Jun Jul Aug Sep Okt Nov Des )],
'month abbreviations for af use non-draft form'
);
is_deeply(
$locale->month_format_narrow(),
[ 1 .. 12 ],
'month narrows for af use draft form because that is the only form available'
);
}
sub check_en_US_POSIX {
my $locale = DateTime::Locale->load('en_US_POSIX');
is( $locale->variant(), 'Computer', 'variant()' );
is( $locale->native_variant(), 'Computer', 'native_variant()' );
is( $locale->language_id(), 'en', 'language_id()' );
is( $locale->territory_id(), 'US', 'territory_id()' );
is( $locale->variant_id(), 'POSIX', 'variant_id()' );
}
sub check_C_locales {
for my $id (qw( C C.ISO-8859-1 C.UTF-8 )) {
my $locale = DateTime::Locale->load($id);
is( $locale->id(), 'C', "$id is accepted as a locale id" );
}
}
sub check_DT_Lang {
foreach my $old (
qw ( Austrian TigrinyaEthiopian TigrinyaEritrean
Brazilian Portuguese
Afar Sidama Tigre )
) {
ok( DateTime::Locale->load($old),
"backwards compatibility for $old" );
}
foreach my $old (qw ( Gedeo )) {
SKIP:
{
skip
'No CLDR XML data for some African languages included in DT::Language',
1
unless $locale_names{$old};
ok( DateTime::Locale->load($old),
"backwards compatibility for $old" );
}
}
}