| BEGIN { |
| if($ENV{PERL_CORE}) { |
| chdir 't'; |
| @INC = '../lib'; |
| } else { |
| push @INC, '../lib'; |
| } |
| } |
| |
| use strict; |
| use Test; |
| BEGIN { plan tests => 26 }; |
| use Pod::Simple::TextContent; |
| use Pod::Simple::Text; |
| |
| BEGIN { |
| *mytime = defined(&Win32::GetTickCount) |
| ? sub () {Win32::GetTickCount() / 1000} |
| : sub () {time()} |
| } |
| |
| $Pod::Simple::Text::FREAKYMODE = 1; |
| use Pod::Simple::TiedOutFH (); |
| |
| chdir 't' unless $ENV{PERL_CORE}; |
| |
| sub source_path { |
| my $file = shift; |
| if ($ENV{PERL_CORE}) { |
| require File::Spec; |
| my $updir = File::Spec->updir; |
| my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 'Simple', 't'); |
| return File::Spec->catfile ($dir, $file); |
| } else { |
| return $file; |
| } |
| } |
| |
| my $outfile = '10000'; |
| |
| foreach my $file ( |
| "junk1.pod", |
| "junk2.pod", |
| "perlcyg.pod", |
| "perlfaq.pod", |
| "perlvar.pod", |
| ) { |
| |
| unless(-e source_path($file)) { |
| ok 0; |
| print "# But $file doesn't exist!!\n"; |
| exit 1; |
| } |
| |
| my @out; |
| my $precooked = source_path($file); |
| $precooked =~ s<\.pod><o.txt>s; |
| unless(-e $precooked) { |
| ok 0; |
| print "# But $precooked doesn't exist!!\n"; |
| exit 1; |
| } |
| |
| print "#\n#\n#\n###################\n# $file\n"; |
| foreach my $class ('Pod::Simple::TextContent', 'Pod::Simple::Text') { |
| my $p = $class->new; |
| push @out, ''; |
| $p->output_string(\$out[-1]); |
| my $t = mytime(); |
| $p->parse_file(source_path($file)); |
| printf "# %s %s %sb, %.03fs\n", |
| ref($p), source_path($file), length($out[-1]), mytime() - $t ; |
| ok 1; |
| } |
| |
| print "# Reading $precooked...\n"; |
| open(IN, $precooked) or die "Can't read-open $precooked: $!"; |
| { |
| local $/; |
| push @out, <IN>; |
| } |
| close(IN); |
| print "# ", length($out[-1]), " bytes pulled in.\n"; |
| |
| |
| for (@out) { s/\s+/ /g; s/^\s+//s; s/\s+$//s; } |
| |
| my $faily = 0; |
| print "#\n#Now comparing 1 and 2...\n"; |
| $faily += compare2($out[0], $out[1]); |
| print "#\n#Now comparing 2 and 3...\n"; |
| $faily += compare2($out[1], $out[2]); |
| print "#\n#Now comparing 1 and 3...\n"; |
| $faily += compare2($out[0], $out[2]); |
| |
| if($faily) { |
| ++$outfile; |
| |
| my @outnames = map $outfile . $_ , qw(0 1); |
| open(OUT2, ">$outnames[0].~out.txt") || die "Can't write-open $outnames[0].txt: $!"; |
| |
| foreach my $out (@out) { push @outnames, $outnames[-1]; ++$outnames[-1] }; |
| pop @outnames; |
| printf "# Writing to %s.txt .. %s.txt\n", $outnames[0], $outnames[-1]; |
| shift @outnames; |
| |
| binmode(OUT2); |
| foreach my $out (@out) { |
| my $outname = shift @outnames; |
| open(OUT, ">$outname.txt") || die "Can't write-open $outname.txt: $!"; |
| binmode(OUT); |
| print OUT $out, "\n"; |
| print OUT2 $out, "\n"; |
| close(OUT); |
| } |
| close(OUT2); |
| } |
| } |
| |
| print "# Wrapping up... one for the road...\n"; |
| ok 1; |
| print "# --- Done with ", __FILE__, " --- \n"; |
| exit; |
| |
| |
| sub compare2 { |
| my @out = @_; |
| if($out[0] eq $out[1]) { |
| ok 1; |
| return 0; |
| } elsif( do{ |
| for ($out[0], $out[1]) { tr/ //d; }; |
| $out[0] eq $out[1]; |
| }){ |
| print "# Differ only in whitespace.\n"; |
| ok 1; |
| return 0; |
| } else { |
| #ok $out[0], $out[1]; |
| |
| my $x = $out[0] ^ $out[1]; |
| $x =~ m/^(\x00*)/s or die; |
| my $at = length($1); |
| print "# Difference at byte $at...\n"; |
| if($at > 10) { |
| $at -= 5; |
| } |
| { |
| print "# ", substr($out[0],$at,20), "\n"; |
| print "# ", substr($out[1],$at,20), "\n"; |
| print "# ^..."; |
| } |
| |
| |
| |
| ok 0; |
| printf "# Unequal lengths %s and %s\n", length($out[0]), length($out[1]); |
| return 1; |
| } |
| } |
| |
| |
| __END__ |
| |