use strict;
use warnings;
use Test::More;
use DateTime;
undef $ENV{PERL_DATETIME_DEFAULT_TZ};
## no critic (Subroutines::ProtectPrivateSubs)
# test _ymd2rd and _rd2ymd for various dates
# 2 tests are performed for each date (on _ymd2rd and _rd2ymd)
# dates are specified as [rd,year,month,day]
for ( # min and max supported days (for 32-bit system)
[ -( 2**28 ), -734951, 9, 7 ],
[ 2**28, 734952, 4, 25 ],
# some miscellaneous dates (these are actually epoch dates for
# various calendars from Calendrical Calculations (1st ed) Table
# 1.1)
[ -1721425, -4713, 11, 24 ],
[ -1373427, -3760, 9, 7 ],
[ -1137142, -3113, 8, 11 ],
[ -1132959, -3101, 1, 23 ],
[ -963099, -2636, 2, 15 ],
[ -1, 0, 12, 30 ], [ 1, 1, 1, 1 ],
[ 2796, 8, 8, 27 ],
[ 103605, 284, 8, 29 ],
[ 226896, 622, 3, 22 ],
[ 227015, 622, 7, 19 ],
[ 654415, 1792, 9, 22 ],
[ 673222, 1844, 3, 21 ]
) {
is(
join( '/', DateTime->_rd2ymd( $_->[0] ) ),
join( '/', @{$_}[ 1 .. 3 ] ),
$_->[0] . " \t=> " . join '/', @{$_}[ 1 .. 3 ]
);
is(
DateTime->_ymd2rd( @{$_}[ 1 .. 3 ] ), $_->[0],
join( '/', @{$_}[ 1 .. 3 ] ) . " \t=> " . $_->[0]
);
}
# normalization tests
for (
[ -1753469, -4797, -33, 1 ],
[ -1753469, -4803, 39, 1 ],
[ -1753105, -4796, -34, 28 ],
[ -1753105, -4802, 38, 28 ]
) {
is(
DateTime->_ymd2rd( @{$_}[ 1 .. 3 ] ), $_->[0],
join( '/', @{$_}[ 1 .. 3 ] )
. " \t=> "
. $_->[0]
. ' (normalization)'
);
}
# test first and last day of each month from Jan -4800..Dec 4800
# this test bails after the first failure with a not ok.
# if it completes successfully, only one ok is issued.
my @mlen = ( 0, 31, 0, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
my ( $dno, $y, $m, $dno2, $y2, $m2, $d2, $mlen ) = ( -1753530, -4800, 1 );
while ( $y <= 4800 ) {
# test $y,$m,1
++$dno;
$dno2 = DateTime->_ymd2rd( $y, $m, 1 );
if ( $dno != $dno2 ) {
is(
$dno2, $dno,
"greg torture test: _ymd2rd($y,$m,1) should be $dno"
);
last;
}
( $y2, $m2, $d2 ) = DateTime->_rd2ymd($dno);
if ( $y2 != $y || $m2 != $m || $d2 != 1 ) {
is(
"$y2/$m2/$d2", "$y/$m/1",
"greg torture test: _rd2ymd($dno) should be $y/$m/1"
);
last;
}
# test $y,$m,$mlen
$mlen = $mlen[$m] || ( $y % 4 ? 28 : $y % 100 ? 29 : $y % 400 ? 28 : 29 );
$dno += $mlen - 1;
$dno2 = DateTime->_ymd2rd( $y, $m, $mlen );
if ( $dno != $dno2 ) {
is(
$dno2, $dno,
"greg torture test: _ymd2rd($y,$m,$mlen) should be $dno"
);
last;
}
( $y2, $m2, $d2 ) = DateTime->_rd2ymd($dno);
if ( $y2 != $y || $m2 != $m || $d2 != $mlen ) {
is(
"$y2/$m2/$d2", "$y/$m/$mlen",
"greg torture test: _rd2ymd($dno) should be $y/$m/$mlen"
);
last;
}
# and on to the next month...
if ( ++$m > 12 ) {
$m = 1;
++$y;
}
}
pass('greg torture test') if $y == 4801;
done_testing();