The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w -I../blib/arch -I../blib/lib -Iblib/arch -Iblib/lib
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Calendar.t'

#########################

# change 'tests => 1' to 'tests => last_test_to_print';

use Test::More 'no_plan';
BEGIN {
    use_ok('Calendar');
}

#########################

# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.

my $ok = 1;                     # global variable for valid

#{{{  Test module loading and valid for one date
my $date;
ok(ref($date=Calendar->new_from_Gregorian(732312)) eq "Calendar::Gregorian",
   "load gregorian calendar");
ok($date->day==1 && $date->month==1 && $date->year==2006,
   "valid gregorian date");

ok(ref($date->convert_to_Julian) eq "Calendar::Julian",
   "load julian calendar");
ok($date->day==19&&$date->month==12&&$date->year==2005,
   "valid julian date");

ok(ref($date->convert_to_China) eq "Calendar::China",
   "load chinese calendar");
ok($date->cycle==78&&$date->year==22&&$date->month==12&&$date->day==2,
   "valid chinese date");
#}}}

#{{{  Test function constructor: from absolute and from [month, day,year]
#     should equal in absolute date
my $skip_convertion = 0;
unless ( $skip_convertion ) {
    diag("Test convetion for twenty years. This may take a long time...");
    my $start_year = 1990;
    my $days = 365*20;
    ok(valid_convert("Gregorian", [1, 1, $start_year], $days), "gregorian finished.");
    ok(valid_convert("Julian", [1, 1, $start_year], $days), "julian finished");
    ok(valid_convert("China", [1, 1, $start_year], $days), "china finished");
}
#}}}

#{{{  Test misc function
# is_leap_year
my $skip_leap_test = 0;
unless ( $skip_leap_test ) {
    $ok = 1;
    foreach ( 1..2000 ) {
        my $date = Calendar->new_from_Gregorian(1, 1, $_);
        if ($date->is_leap_year xor gregorian_is_leap_year($_)) {
            print $date, "\n";
            $ok = 0;
        }
    }
    ok($ok, "gregorian leap predicate");

    $ok = 1;
    foreach ( 1..2000 ) {
        my $date = Calendar->new_from_Julian(1, 1, $_);
        $ok = 0 if ($date->is_leap_year xor julian_is_leap_year($_));
    }
    ok($ok, "julian leap predicate");
}

# day_of_year
foreach my $year ( 2000, 2001 ) {
    my $date = Calendar->new_from_Gregorian(1, 1, $year);
    my $last = ($date->is_leap_year ? 366 : 365);
    require Time::Local;
    my $time = Time::Local::timelocal(0, 0, 0, 1, 0, $year-1900);
    foreach ( 1..$last ) {
        my @time = localtime($time+($_-1)*86400);
        # printf ("%d => %d\n", $date->day_of_year, $time[7]);
        $ok = 0 unless $date->day_of_year == $time[7]+1;
        $date = $date + 1;
    }
}
ok($ok, "Gregorian day of year");

foreach my $year ( 2000, 2001 ) {
    my $date = Calendar->new_from_Julian(1, 1, $year);
    my $last = ($date->is_leap_year ? 366 : 365);
    foreach ( 1..$last ) {
        # printf ("%d => %d\n", $date->day_of_year, $_);
        $ok = 0 unless $date->day_of_year == $_;
        $date = $date + 1;
    }
}
ok($ok, "Julian day of year");

# last_day_of_month
my @month_days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

$ok = 1;
foreach my $year ( 2000, 2001 ) {
    my $date = Calendar->new_from_Gregorian(1, 1, $year);
    my @days = @month_days;
    $days[1]++ if $date->is_leap_year;
    foreach my $month (1..12) {
        my $date = Calendar->new_from_Gregorian($month, int(rand(27)+1), $year);
        $ok = 0 unless $date->last_day_of_month == $days[$date->month-1];
    }
}
ok($ok, "Gregorian last day of month");

$ok = 1;
foreach my $year ( 2000, 2001 ) {
    my $date = Calendar->new_from_Julian(1, 1, $year);
    my @days = @month_days;
    $days[1]++ if $date->is_leap_year;
    foreach my $month (1..12) {
        my $date = Calendar->new_from_Julian($month, int(rand(27)+1), $year);
        $ok = 0 unless $date->last_day_of_month == $days[$date->month-1];
    }
}
ok($ok, "Julian last day of month");
#}}}

sub gregorian_is_leap_year {
    my $year = shift;
    if ( $year < 0 ) {
        $year = abs($year) - 1;
    }
    ($year%4 == 0) && ($year%100>0 || ($year%400 == 0));
}

sub julian_is_leap_year {
    my $year = shift;
    if ( $year < 0 ) {
        $year = abs($year) - 1;
    }
    $year % 4 == 0
}

sub valid_convert {
    my ($package, $start, $days) = @_;
    $start = Calendar->new_from_Gregorian(@$start)->absolute_date;
    my $mod = "Calendar::$package";
    my $func = \&{"Calendar::new_from_$package"};
    my $i = 0;
    my $ok = 1;
    while ( $i<$days ) {
        my $date = $func->($mod, $start +$i);
        delete $date->{absolute};
        if ( $date->absolute_date != ($start+$i) ) {
            warn "absolute date ". $start+$i . "not convert correctly!\n";
            $ok = 0;
        }
        $i++;
    }
    return $ok;
}

# create_data("Gregorian", [1, 1, 1990], 365*20, "perl");
# create_data("Julian", [1, 1, 1990], 365*20, "perl");
# create_data("China", [1, 1, 1990], 365*20, "perl");

sub create_data {
    my ($package, $start, $days, $file) = @_;
    my $oldout;
    if ( $file ) {
        open($oldout, ">&STDOUT") || die "Can't dup STDOUT: $!";
        open(STDOUT, ">$file-$package.txt") or die "Can't create file $file-$package.txt: $!";
    }
    $start = Calendar->new_from_Gregorian(@$start)->absolute_date;
    my $mod = "Calendar::$package";
    my $func = \&{"Calendar::new_from_$package"};
    my $i = 0;
    if ( $package eq 'China' ) {
        while ( $i<$days ) {
            my $date = $func->($mod, $start +$i);
            printf "%d => (%d %d %s %d)\n", $date->absolute_date,
                $date->cycle, $date->year, $date->month, $date->day;
            $i++;
        }
    }
    else {
        while ( $i<$days ) {
            my $date = $func->($mod, $start +$i);
            printf "%d => (%d %d %d)\n", $date->absolute_date,
                $date->month, $date->day , $date->year;
            $i++;
        }
    }
    if ( $file ) {
        open(STDOUT, ">&", $oldout) or die "Can't restore STDOUT: $!";
    }
}