X-Git-Url: https://git.donarmstrong.com/?p=deb_pkgs%2Flibhtml-calendarmonth-perl.git;a=blobdiff_plain;f=1.17%2Ft%2Ftestload.pm;fp=1.17%2Ft%2Ftestload.pm;h=0000000000000000000000000000000000000000;hp=d822ee7742b564ace66c3d17cf7e2b5c853c89bb;hb=ed44be48bb467d82127717d1ae2d11890aaf329b;hpb=982e2bb08f00d800e2cd9fb65b108231719c8a65 diff --git a/1.17/t/testload.pm b/1.17/t/testload.pm deleted file mode 100644 index d822ee7..0000000 --- a/1.17/t/testload.pm +++ /dev/null @@ -1,133 +0,0 @@ -package testload; - -use vars qw( @ISA @EXPORT $Dat_Dir ); - -use strict; -use Test::More; - -my $DEBUG = 0; - -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw( $Dat_Dir check_datetool case_count - check_basic_with_datetool - check_woy_with_datetool - ); - -use File::Spec; - -use HTML::CalendarMonth; -use HTML::CalendarMonth::DateTool; - -my $base_dir; -BEGIN { - my $pkg = __PACKAGE__; - $pkg =~ s%::%/%g; - $pkg .= '.pm'; - $pkg = File::Spec->canonpath($INC{$pkg}); - $pkg =~ s/\/[^\/]+\.pm$//; - $base_dir = $pkg; -} -$Dat_Dir = $base_dir; - -my($tcount, $rds, %dates, @tmethods, @twy_methods, @Cals); - -# Required test dates -open(D, "$Dat_Dir/test.dat") or die "Problem reading $Dat_Dir/test.dat: $!\n"; -$rds = ; -foreach (split(' ', $rds)) { - ++$dates{$_}; -} - -my %WOY_data; -eval join('', ); -die "Oops on eval: $@\n" if $@; - -# Today's date -my($month, $year) = (localtime(time))[4,5]; -++$month; -$year += 1900; - -# Flag tests for a year -foreach my $y ($year .. $year + 1) { - foreach my $m (1 .. 12) { - ++$dates{sprintf("%d/%02d", $y, $m)}; - } -} - -# Yank test cases -while () { - chomp; - my($d, $wb) = split(' ', $_); - my($y, $m) = split('/', $d); - my $cal = ; - push(@Cals, [$y, $m, $cal, $wb]) if $dates{"$y/$m"}; -} - -close(D); - -sub case_count { scalar @Cals } - -sub check_datetool { - my $datetool = shift; - my $module = HTML::CalendarMonth::DateTool->toolmap($datetool); - ok($module, "toolmap($datetool) : $module"); - require_ok($module); -} - -sub check_basic_with_datetool { - my $datetool = shift; - my @days = qw( Sun Mon Tue Wed Thr Fri Sat ); - my $method = $datetool || 'auto-select'; - foreach my $cal (@Cals) { - my $c = HTML::CalendarMonth->new( - year => $cal->[0], - month => $cal->[1], - week_begin => $cal->[3], - datetool => $datetool, - ); - my $day1 = $days[$cal->[3] - 1]; - cmp_ok($c->as_HTML, 'eq', $cal->[2], - sprintf("(%d/%-02d %s 1st day) using %s", - $cal->[0], $cal->[1], $day1, $method)); - if ($DEBUG && $c->as_HTML ne $cal->[2]) { - debug_dump('Broken', $c->as_HTML, 'Test Data', $cal->[2]); - } - } -} - -sub check_woy_with_datetool { - my $datetool = shift; - my $year = 2000; - foreach my $month (qw(01 12)) { - my $tc = $WOY_data{"$year/$month"}; - my $cal = HTML::CalendarMonth->new( - year => $year, - month => $month, - head_week => 1, - datetool => $datetool, - ); - my $ct = $cal->as_HTML; - chomp $ct; - cmp_ok($ct, 'eq', $tc, "($year/$month week of year) using $datetool"); - if ($DEBUG && $ct ne $tc) { - debug_dump('Broken', $ct, 'Test Data', $tc); - } - } -} - -sub debug_dump { - my($l1, $str1, $l2, $str2) = @_; - local(*DUMP); - open(DUMP, ">$DEBUG") or die "Could not dump to $DEBUG: $!\n"; - print DUMP "
$l1$l2
\n"; - print DUMP "$str1\n\n"; - print DUMP "$str2\n
\n"; - close(DUMP); - print STDERR "\nDumped tables to $DEBUG. Aborting test.\n"; - exit; -} - -__DATA__ -$WOY_data{'2000/01'} = '
January2000
SunMonTueWedThuFriSat 
            152
23456781
91011121314152
161718192021223
232425262728294
3031          5
'; -$WOY_data{'2000/12'} = '
December2000
SunMonTueWedThuFriSat 
          1248
345678949
1011121314151650
1718192021222351
2425262728293052
31            1
';