render.t

source of perl for linux application,

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__