1use Test::More qw(no_plan); 2 3BEGIN { use_ok('Date::ICal') }; 4 5my $harness = $ENV{HARNESS_ACTIVE}; 6$|=1 unless $harness; 7 8# test greg2jd and jd2greg for various dates 9# 2 tests are performed for each date (on greg2jd and jd2greg) 10# dates are specified as [jd,year,month,day] 11for ( 12 # min and max supported days (for 32-bit system) 13 [-2**31,-5879610,6,22],[2**31-1,5879611,7,11], 14 15 # some miscellaneous dates I had day numbers for (these are 16 # actually epoch dates for various calendars from Calendrical 17 # Calculations (1st ed) Table 1.1) 18 19 [-1721425,-4713,11,24],[-1373427,-3760,9,7],[-1137142,-3113,8,11], 20 [-1132959,-3101,1,23],[-963099,-2636,2,15],[-1,0,12,30],[1,1,1,1], 21 [2796,8,8,27],[103605,284,8,29],[226896,622,3,22],[227015,622,7,19], 22 [654415,1792,9,22],[673222,1844,3,21] 23) { 24 is(join('/',Date::ICal::jd2greg($_->[0])), join('/',@{$_}[1..3]), 25 $_->[0]." \t=> ".join'/',@{$_}[1..3]); 26 is(Date::ICal::greg2jd(@{$_}[1..3]), $_->[0], 27 join('/',@{$_}[1..3])." \t=> ".$_->[0]); 28} 29 30# normalization tests 31for ( 32 [-1753469,-4797,-33,1],[-1753469,-4803,39,1], 33 [-1753105,-4796,-34,28],[-1753105,-4802,38,28] 34) { 35 is(Date::ICal::greg2jd(@{$_}[1..3]), $_->[0], 36 join('/',@{$_}[1..3])." \t=> ".$_->[0]." (normalization)"); 37} 38 39# test first and last day of each month from Jan -4800..Dec 4800 40# this test bails after the first failure with a not ok. 41# if it comlpetes successfully, only one ok is issued. 42 43my @mlen=(0,31,0,31,30,31,30,31,31,30,31,30,31); 44my ($dno,$y,$m,$dno2,$y2,$m2,$d2,$mlen) = (-1753530,-4800,1); 45 46print "# this may take a minute...\n"; 47while ( $y <= 4800 ) { 48 49 # test $y,$m,1 50 ++$dno; 51 $dno2 = Date::ICal::greg2jd( $y, $m, 1 ); 52 if ( $dno != $dno2 ) { 53 is( $dno2, $dno, "greg torture test: greg2jd($y,$m,1) should be $dno" ); 54 last; 55 } 56 ( $y2, $m2, $d2 ) = Date::ICal::jd2greg($dno); 57 58 if ( $y2 != $y || $m2 != $m || $d2 != 1 ) { 59 is( "$y2/$m2/$d2", "$y/$m/1", 60 "greg torture test: jd2greg($dno) should be $y/$m/1" ); 61 last; 62 } 63 64 # test $y,$m,$mlen 65 $mlen = $mlen[$m] || ( $y % 4 ? 28 : $y % 100 ? 29 : $y % 400 ? 28 : 29 ); 66 $dno += $mlen - 1; 67 $dno2 = Date::ICal::greg2jd( $y, $m, $mlen ); 68 if ( $dno != $dno2 ) { 69 is( $dno2, $dno, 70 "greg torture test: greg2jd($y,$m,$mlen) should be $dno" ); 71 last; 72 } 73 ( $y2, $m2, $d2 ) = Date::ICal::jd2greg($dno); 74 75 if ( $y2 != $y || $m2 != $m || $d2 != $mlen ) { 76 is( "$y2/$m2/$d2", "$y/$m/$mlen", 77 "greg torture test: jd2greg($dno) should be $y/$m/$mlen" ); 78 last; 79 } 80 81 # and on to the next month... 82 if ( ++$m > 12 ) { 83 $m = 1; 84 ++$y; 85 print "\r$y " unless $harness || $y % 100; 86 } 87} 88print "\n" unless $harness; 89pass("greg torture test") if $y==4801; 90 91