my
@locale_codes
=
sort
DateTime::Locale->codes;
my
%locale_names
=
map
{
$_
=> 1 } DateTime::Locale->names;
my
%locale_codes
=
map
{
$_
=> 1 } DateTime::Locale->codes;
my
%is_locale_without_en_data
=
map
{
$_
=> 1 }
qw(
skr
)
;
my
%is_locale_without_native_data
=
map
{
$_
=> 1 }
qw(
aa
aa-DJ
aa-ER
aa-ET
bew
bew-ID
bm-Nkoo
bm-Nkoo-ML
byn
byn-ER
cad
cad-US
cu
cu-RU
dv
dv-MV
en-Shaw
en-Shaw-GB
gez
gez-ER
gez-ET
ha-Arab
ha-Arab-NG
ha-Arab-SD
iu
iu-CA
iu-Latn
iu-Latn-CA
la
la-VA
mn-Mong
mn-Mong-CN
ms-Arab
ms-Arab-BN
ms-Arab-MY
nmg
nr
nr-ZA
nso
sid
sid-ET
tig
tig-ER
tn
tn-BW
ts
ts-ZA
tyv
tyv-RU
ve
ve-ZA
vo
vo-001
wal
wal-ET
)
;
subtest(
'basic overall tests'
, \
&basic_tests
);
for
my
$code
(
@locale_codes
) {
subtest(
"basic tests for $code"
,
sub
{ test_one_locale(
$code
) } );
}
subtest(
'und locale'
, \
&check_und
);
subtest(
'en locale'
, \
&check_en
);
subtest(
'en-GB locale'
, \
&check_en_GB
);
subtest(
'en-US locale'
, \
&check_en_US
);
subtest(
'es-ES locale'
, \
&check_es_ES
);
subtest(
'af locale'
, \
&check_af
);
subtest(
'C locales'
, \
&check_C_locales
);
subtest(
'DateTime::Language back-compat'
, \
&check_DT_Lang
);
done_testing();
sub
basic_tests {
ok(
@locale_codes
>= 240,
'Coverage looks complete'
);
ok(
$locale_names
{English},
q{Locale name 'English' found}
);
ok(
$locale_codes
{
'ar-JO'
},
q{Locale code 'ar-JO' found}
);
like(
dies { DateTime::Locale->load(
'Does not exist'
) },
qr/invalid/
i,
'invalid locale name/code to DateTime::Locale->load causes an error'
);
my
$l
= DateTime::Locale->load(
'en-US.LATIN-1'
);
is(
$l
->code,
'en-US'
,
'code is en-US when loading en-US.LATIN-1'
);
is(
DateTime::Locale->load(
'en_US'
)->code,
'en-US'
,
'underscores in code name are turned into dashes'
);
}
sub
test_one_locale {
my
$code
=
shift
;
my
$locale
;
is(
dies {
$locale
= DateTime::Locale->load(
$code
) },
undef
,
"no exception loading locale for $code"
);
isa_ok(
$locale
,
'DateTime::Locale::FromData'
);
return
if
$code
eq
'und'
;
is(
$locale
->code,
$code
,
'$locale->code returns the code used to load the locale'
);
if
(
$is_locale_without_en_data
{
$code
} ) {
is(
$locale
->name,
q{}
,
'does not have a native locale name'
,
);
}
else
{
ok(
length
$locale
->name,
'has a locale name'
);
}
if
(
$is_locale_without_native_data
{
$code
} ) {
is(
$locale
->native_name,
q{}
,
'does not have a native locale name'
,
);
}
else
{
ok(
length
$locale
->native_name,
'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
=>
'quarter_format_narrow'
,
count
=> 4,
}, {
locale_method
=>
'am_pm_abbreviated'
,
count
=> 2,
}, {
locale_method
=>
'era_wide'
,
count
=> 2,
}, {
locale_method
=>
'era_abbreviated'
,
count
=> 2,
}, {
locale_method
=>
'era_narrow'
,
count
=> 2,
},
) {
check_array(
locale
=>
$locale
, %{
$test
} );
}
is(
scalar
@{
$locale
->day_format_narrow }, 7,
'$locale->day_format_narrow returns 7 items'
);
is(
scalar
@{
$locale
->month_format_narrow }, 12,
'$locale->month_format_narrow returns 12 items'
);
is(
scalar
@{
$locale
->day_stand_alone_narrow }, 7,
'$locale->day_stand_alone_narrow returns 7 items'
);
is(
scalar
@{
$locale
->month_stand_alone_narrow }, 12,
'$locale->month_stand_alone_narrow returns 12 items'
);
check_formats(
$locale
,
'date_formats'
,
'date_format'
);
check_formats(
$locale
,
'time_formats'
,
'time_format'
);
}
sub
check_array {
my
%test
=
@_
;
my
$locale_method
=
$test
{locale_method};
my
%unique
=
map
{
$_
=> 1 } @{
$test
{locale}->
$locale_method
};
is(
keys
%unique
,
$test
{count},
qq{'$locale_method' contains $test{count}
unique items}
);
}
sub
check_formats {
my
(
$locale
,
$hash_func
,
$item_func
) =
@_
;
my
%unique
=
map
{
$_
=> 1 }
values
%{
$locale
->
$hash_func
};
ok(
keys
%unique
>= 1,
qq{'$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 returned undef for $method"
);
}
}
is(
keys
%unique
, 0,
qq{data returned by '$hash_func' and '$item_func patterns' matches}
);
}
sub
check_und {
my
$locale
= DateTime::Locale->load(
'und'
);
my
%tests
= (
day_format_wide
=> [
qw( Mon Tue Wed Thu Fri Sat Sun )
],
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( Mon Tue Wed Thu Fri Sat Sun )
],
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( M01 M02 M03 M04 M05 M06 M07 M08 M09 M10 M11 M12 )
],
month_format_abbreviated
=>
[
qw( M01 M02 M03 M04 M05 M06 M07 M08 M09 M10 M11 M12 )
],
month_format_narrow
=> [
qw( 1 2 3 4 5 6 7 8 9 10 11 12 )
],
month_stand_alone_wide
=>
[
qw( M01 M02 M03 M04 M05 M06 M07 M08 M09 M10 M11 M12 )
],
month_stand_alone_abbreviated
=>
[
qw( M01 M02 M03 M04 M05 M06 M07 M08 M09 M10 M11 M12 )
],
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
=>
'y MMMM d, EEEE 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
=>
'y-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
= (
Bh
=>
'h B'
,
Bhm
=>
'h:mm B'
,
Bhms
=>
'h:mm:ss B'
,
E
=>
'ccc'
,
EBhm
=>
'E h:mm B'
,
EBhms
=>
'E h:mm:ss B'
,
EHm
=>
'E HH:mm'
,
EHms
=>
'E HH:mm:ss'
,
Ed
=>
'd, E'
,
Ehm
=>
'E h:mm a'
,
Ehms
=>
'E h:mm:ss a'
,
Gy
=>
'G y'
,
GyMMM
=>
'G y MMM'
,
GyMMMEd
=>
'G y MMM d, E'
,
GyMMMd
=>
'G y MMM d'
,
GyMd
=>
'GGGGG y-MM-dd'
,
H
=>
'HH'
,
Hm
=>
'HH:mm'
,
Hms
=>
'HH:mm:ss'
,
Hmsv
=>
'HH:mm:ss v'
,
Hmv
=>
'HH:mm v'
,
M
=>
'L'
,
MEd
=>
'MM-dd, E'
,
MMM
=>
'LLL'
,
MMMEd
=>
'MMM d, E'
,
'MMMMW-count-other'
=>
q{'week' W 'of' MMMM}
,
MMMMd
=>
'MMMM d'
,
MMMd
=>
'MMM d'
,
Md
=>
'MM-dd'
,
d
=>
'd'
,
h
=>
'h a'
,
hm
=>
'h:mm a'
,
hms
=>
'h:mm:ss a'
,
hmsv
=>
'h:mm:ss a v'
,
hmv
=>
'h:mm a v'
,
ms
=>
'mm:ss'
,
y
=>
'y'
,
yM
=>
'y-MM'
,
yMEd
=>
'y-MM-dd, E'
,
yMMM
=>
'y MMM'
,
yMMMEd
=>
'y MMM d, E'
,
yMMMM
=>
'y MMMM'
,
yMMMd
=>
'y MMM d'
,
yMd
=>
'y-MM-dd'
,
yQQQ
=>
'y QQQ'
,
yQQQQ
=>
'y QQQQ'
,
'yw-count-other'
=>
q{'week' w 'of' Y}
,
);
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(),
month_format_abbreviated
=>
[
qw( Jan Feb Mar Apr May Jun Jul Aug Sept Oct Nov Dec )
],
month_stand_alone_abbreviated
=>
[
qw( Jan Feb Mar Apr May Jun Jul Aug Sept Oct Nov Dec )
],
am_pm_abbreviated
=> [
'am'
,
'pm'
],
first_day_of_week
=> 1,
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_code
=>
'en'
,
territory_code
=>
'GB'
,
variant_code
=>
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
= (
Bh
=>
'h B'
,
Bhm
=>
'h:mm B'
,
Bhms
=>
'h:mm:ss B'
,
E
=>
'ccc'
,
EBhm
=>
'E h:mm B'
,
EBhms
=>
'E h:mm:ss B'
,
EHm
=>
'E HH:mm'
,
EHms
=>
'E HH:mm:ss'
,
Ed
=>
'E d'
,
Ehm
=>
"E h:mm\N{U+202f}a"
,
'Ehm-alt-ascii'
=>
'E h:mm a'
,
Ehms
=>
"E h:mm:ss\N{U+202f}a"
,
'Ehms-alt-ascii'
=>
'E h:mm:ss a'
,
Gy
=>
'y G'
,
GyMMM
=>
'MMM y G'
,
GyMMMEEEEd
=>
'EEEE d MMM y G'
,
GyMMMEd
=>
'E, d MMM y G'
,
GyMMMd
=>
'd MMM y G'
,
GyMd
=>
'dd/MM/y G'
,
H
=>
'HH'
,
Hm
=>
'HH:mm'
,
Hms
=>
'HH:mm:ss'
,
Hmsv
=>
'HH:mm:ss v'
,
Hmv
=>
'HH:mm v'
,
M
=>
'L'
,
MEd
=>
'E, dd/MM'
,
MMM
=>
'LLL'
,
MMMEEEEd
=>
'EEEE d MMM'
,
MMMEd
=>
'E, d MMM'
,
MMMMEEEEd
=>
'EEEE d MMMM'
,
'MMMMW-count-one'
=>
q{'week' W 'of' MMMM}
,
'MMMMW-count-other'
=>
q{'week' W 'of' MMMM}
,
MMMMd
=>
'd MMMM'
,
MMMd
=>
'd MMM'
,
MMdd
=>
'dd/MM'
,
Md
=>
'dd/MM'
,
d
=>
'd'
,
h
=>
"h\N{U+202f}a"
,
'h-alt-ascii'
=>
'h a'
,
hm
=>
"h:mm\N{U+202f}a"
,
'hm-alt-ascii'
=>
'h:mm a'
,
hms
=>
"h:mm:ss\N{U+202f}a"
,
'hms-alt-ascii'
=>
'h:mm:ss a'
,
hmsv
=>
"h:mm:ss\N{U+202f}a v"
,
'hmsv-alt-ascii'
=>
'h:mm:ss a v'
,
hmv
=>
"h:mm\N{U+202f}a v"
,
'hmv-alt-ascii'
=>
'h:mm a v'
,
ms
=>
'mm:ss'
,
y
=>
'y'
,
yM
=>
'MM/y'
,
yMEd
=>
'E, dd/MM/y'
,
yMMM
=>
'MMM y'
,
yMMMEEEEd
=>
'EEEE d MMM y'
,
yMMMEd
=>
'E, d MMM y'
,
yMMMM
=>
'MMMM y'
,
yMMMMEEEEd
=>
'EEEE d MMMM y'
,
yMMMd
=>
'd MMM y'
,
yMd
=>
'dd/MM/y'
,
yQQQ
=>
'QQQ y'
,
yQQQQ
=>
'QQQQ y'
,
'yw-count-one'
=>
q{'week' w 'of' Y}
,
'yw-count-other'
=>
q{'week' w 'of' Y}
,
);
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
->code;
if
(
ref
$tests
{
$k
} ) {
is(
$locale
->
$k
,
$tests
{
$k
},
$desc
);
}
else
{
is(
$locale
->
$k
,
$tests
{
$k
},
$desc
);
}
}
}
sub
test_formats {
my
$locale
=
shift
;
my
%formats
=
@_
;
for
my
$name
(
sort
keys
%formats
) {
is(
$locale
->format_for(
$name
),
$formats
{
$name
},
"Format for $name with "
.
$locale
->code
);
}
is(
[
$locale
->available_formats ],
[
sort
keys
%formats
],
'Available formats for '
.
$locale
->code .
' 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_code,
'es'
,
'language_code'
);
is(
$locale
->territory_code,
'ES'
,
'territory_code'
);
is(
$locale
->variant_code,
undef
,
'variant_code'
);
}
sub
check_af {
my
$locale
= DateTime::Locale->load(
'af'
);
is(
$locale
->month_format_abbreviated,
[
qw( Jan. Feb. Mrt. Apr. Mei Jun. Jul. Aug. Sep. Okt. Nov. Des. )
],
'month abbreviations for af use non-draft form'
);
is(
$locale
->month_format_narrow,
[
qw( J F M A M J J A S O N D )
],
'month narrows for af use draft form because that is the only form available'
);
}
sub
check_C_locales {
for
my
$code
(
qw( C C.ISO-8859-1 C.UTF-8 POSIX )
) {
my
$locale
= DateTime::Locale->load(
$code
);
is(
$locale
->code,
'en-US'
,
"$code is accepted as a locale code"
);
}
}
sub
check_DT_Lang {
my
@old_names
=
qw(
Austrian
TigrinyaEthiopian
TigrinyaEritrean
Brazilian
Portugese
)
;
foreach
my
$old
(
@old_names
) {
ok(
DateTime::Locale->load(
$old
),
"backwards compatibility for $old"
);
}
foreach
my
$old
(
qw( Gedeo Afar Sidama Tigre )
) {
SKIP:
{
skip
'No CLDR data for some African languages included in DT::Language'
,
1
unless
$locale_names
{
$old
};
ok(
DateTime::Locale->load(
$old
),
"backwards compatibility for $old"
);
}
}
}