|
Packit |
eb839c |
use warnings;
|
|
Packit |
eb839c |
use strict;
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
use Test::More tests => 1 + 3*12 + 5 + 6*21 + 11;
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
BEGIN {
|
|
Packit |
eb839c |
use_ok "Date::ISO8601",
|
|
Packit |
eb839c |
qw(year_weeks cjdn_to_ywd ywd_to_cjdn present_ywd);
|
|
Packit |
eb839c |
}
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
my $have_bigint = eval("use Math::BigInt 1.16; 1");
|
|
Packit |
eb839c |
my $have_bigrat = eval("use Math::BigRat 0.04; 1");
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
sub match_val($$) {
|
|
Packit |
eb839c |
my($a, $b) = @_;
|
|
Packit |
eb839c |
ok ref($a) eq ref($b) && $a == $b;
|
|
Packit |
eb839c |
}
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
sub match_vec($$) {
|
|
Packit |
eb839c |
my($a, $b) = @_;
|
|
Packit |
eb839c |
unless(@$a == @$b) {
|
|
Packit |
eb839c |
ok 0;
|
|
Packit |
eb839c |
return;
|
|
Packit |
eb839c |
}
|
|
Packit |
eb839c |
for(my $i = 0; $i != @$a; $i++) {
|
|
Packit |
eb839c |
my $aval = $a->[$i];
|
|
Packit |
eb839c |
my $bval = $b->[$i];
|
|
Packit |
eb839c |
unless(ref($aval) eq ref($bval) && $aval == $bval) {
|
|
Packit |
eb839c |
ok 0;
|
|
Packit |
eb839c |
return;
|
|
Packit |
eb839c |
}
|
|
Packit |
eb839c |
}
|
|
Packit |
eb839c |
ok 1;
|
|
Packit |
eb839c |
}
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
my @prep = (
|
|
Packit |
eb839c |
sub { $_[0] },
|
|
Packit |
eb839c |
sub { $have_bigint ? Math::BigInt->new($_[0]) : undef },
|
|
Packit |
eb839c |
sub { $have_bigrat ? Math::BigRat->new($_[0]) : undef },
|
|
Packit |
eb839c |
);
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
sub check_weeks($$) {
|
|
Packit |
eb839c |
my($y, $yw) = @_;
|
|
Packit |
eb839c |
foreach my $prep (@prep) { SKIP: {
|
|
Packit |
eb839c |
my $py = $prep->($y);
|
|
Packit |
eb839c |
skip "numeric type unavailable", 1 unless defined $py;
|
|
Packit |
eb839c |
match_val year_weeks($py), $yw;
|
|
Packit |
eb839c |
} }
|
|
Packit |
eb839c |
}
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
check_weeks(-1994, 52);
|
|
Packit |
eb839c |
check_weeks(-1993, 52);
|
|
Packit |
eb839c |
check_weeks(-1991, 53);
|
|
Packit |
eb839c |
check_weeks(-1985, 53);
|
|
Packit |
eb839c |
check_weeks(-1980, 53);
|
|
Packit |
eb839c |
check_weeks(-1975, 52);
|
|
Packit |
eb839c |
check_weeks(2006, 52);
|
|
Packit |
eb839c |
check_weeks(2007, 52);
|
|
Packit |
eb839c |
check_weeks(2009, 53);
|
|
Packit |
eb839c |
check_weeks(2015, 53);
|
|
Packit |
eb839c |
check_weeks(2020, 53);
|
|
Packit |
eb839c |
check_weeks(2025, 52);
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
eval { ywd_to_cjdn(2006, 0, 1); };
|
|
Packit |
eb839c |
like $@, qr/\Aweek number /;
|
|
Packit |
eb839c |
eval { ywd_to_cjdn(2006, 53, 1); };
|
|
Packit |
eb839c |
like $@, qr/\Aweek number /;
|
|
Packit |
eb839c |
eval { ywd_to_cjdn(2009, 54, 1); };
|
|
Packit |
eb839c |
like $@, qr/\Aweek number /;
|
|
Packit |
eb839c |
eval { ywd_to_cjdn(2000, 1, 0); };
|
|
Packit |
eb839c |
like $@, qr/\Aday number /;
|
|
Packit |
eb839c |
eval { ywd_to_cjdn(2000, 1, 8); };
|
|
Packit |
eb839c |
like $@, qr/\Aday number /;
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
sub check_conv($$$$) {
|
|
Packit |
eb839c |
my($cjdn, $y, $w, $d) = @_;
|
|
Packit |
eb839c |
foreach my $prep (@prep) { SKIP: {
|
|
Packit |
eb839c |
skip "numeric type unavailable", 2 unless defined $prep->(0);
|
|
Packit |
eb839c |
match_vec [ cjdn_to_ywd($prep->($cjdn)) ],
|
|
Packit |
eb839c |
[ $prep->($y), $w, $d ];
|
|
Packit |
eb839c |
match_vec [ $prep->($cjdn) ],
|
|
Packit |
eb839c |
[ ywd_to_cjdn($prep->($y), $w, $d) ];
|
|
Packit |
eb839c |
} }
|
|
Packit |
eb839c |
}
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
check_conv(0, -4713, 48, 1);
|
|
Packit |
eb839c |
check_conv(1721060, -1, 52, 6);
|
|
Packit |
eb839c |
check_conv(2406029, 1875, 20, 4);
|
|
Packit |
eb839c |
check_conv(2441317, 1971, 52, 5);
|
|
Packit |
eb839c |
check_conv(2441318, 1971, 52, 6);
|
|
Packit |
eb839c |
check_conv(2441319, 1971, 52, 7);
|
|
Packit |
eb839c |
check_conv(2441320, 1972, 1, 1);
|
|
Packit |
eb839c |
check_conv(2441683, 1972, 52, 7);
|
|
Packit |
eb839c |
check_conv(2441684, 1973, 1, 1);
|
|
Packit |
eb839c |
check_conv(2442047, 1973, 52, 7);
|
|
Packit |
eb839c |
check_conv(2442048, 1974, 1, 1);
|
|
Packit |
eb839c |
check_conv(2442049, 1974, 1, 2);
|
|
Packit |
eb839c |
check_conv(2443139, 1976, 52, 7);
|
|
Packit |
eb839c |
check_conv(2443140, 1976, 53, 1);
|
|
Packit |
eb839c |
check_conv(2443141, 1976, 53, 2);
|
|
Packit |
eb839c |
check_conv(2443142, 1976, 53, 3);
|
|
Packit |
eb839c |
check_conv(2443143, 1976, 53, 4);
|
|
Packit |
eb839c |
check_conv(2443144, 1976, 53, 5);
|
|
Packit |
eb839c |
check_conv(2443145, 1976, 53, 6);
|
|
Packit |
eb839c |
check_conv(2443146, 1976, 53, 7);
|
|
Packit |
eb839c |
check_conv(2443147, 1977, 1, 1);
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
is present_ywd(2406029), "1875-W20-4";
|
|
Packit |
eb839c |
is present_ywd(1875, 20, 4), "1875-W20-4";
|
|
Packit |
eb839c |
is present_ywd(2441320), "1972-W01-1";
|
|
Packit |
eb839c |
is present_ywd(1972, 1, 1), "1972-W01-1";
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
is present_ywd(1233, 0, 0), "1233-W00-0";
|
|
Packit |
eb839c |
is present_ywd(1233, 53, 1), "1233-W53-1";
|
|
Packit |
eb839c |
is present_ywd(1233, 99, 9), "1233-W99-9";
|
|
Packit |
eb839c |
eval { present_ywd(1233, -1, 1) }; isnt $@, "";
|
|
Packit |
eb839c |
eval { present_ywd(1233, 100, 1) }; isnt $@, "";
|
|
Packit |
eb839c |
eval { present_ywd(1233, 1, -1) }; isnt $@, "";
|
|
Packit |
eb839c |
eval { present_ywd(1233, 1, 10) }; isnt $@, "";
|
|
Packit |
eb839c |
|
|
Packit |
eb839c |
1;
|