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