lib/Pod/Simple/t/reinit.t

   1 BEGIN {
   2     chdir 't' if -d 't';
   3     if($ENV{PERL_CORE}) {
   4         @INC = '../lib';
   5     }
   6 }
   7
   8 use lib '../lib';
   9
  10 use strict;
  11 use Test;
  12 BEGIN { plan tests => 5 };
  13
  14 sub source_path {
  15     my $file = shift;
  16     if ($ENV{PERL_CORE}) {
  17         require File::Spec;
  18         my $updir = File::Spec->updir;
  19         my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 'Simple', 't');
  20         return File::Spec->catfile ($dir, $file);
  21     } else {
  22         return $file;
  23     }
  24 }
  25
  26 use Pod::Simple::Text;
  27 $Pod::Simple::Text::FREAKYMODE = 1;
  28
  29 my $parser  = Pod::Simple::Text->new();
  30
  31 foreach my $file (
  32   "junk1.pod",
  33   "junk2.pod",
  34   "perlcyg.pod",
  35   "perlfaq.pod",
  36   "perlvar.pod",
  37 ) {
  38
  39   unless(-e source_path($file)) {
  40     ok 0;
  41     print "# But $file doesn't exist!!\n";
  42     next;
  43   }
  44
  45     my $precooked = source_path($file);
  46     my $outstring;
  47     my $compstring;
  48     $precooked =~ s<\.pod><o.txt>s;
  49     $parser->reinit;
  50     $parser->output_string(\$outstring);
  51     $parser->parse_file(source_path($file));
  52
  53     open(IN, $precooked) or die "Can't read-open $precooked: $!";
  54     {
  55       local $/;
  56       $compstring = <IN>;
  57     }
  58     close(IN);
  59
  60     for ($outstring,$compstring) { s/\s+/ /g; s/^\s+//s; s/\s+$//s; }
  61
  62     if($outstring eq $compstring) {
  63       ok 1;
  64       next;
  65     } elsif( do{
  66       for ($outstring, $compstring) { tr/ //d; };
  67       $outstring eq $compstring;
  68     }){
  69       print "# Differ only in whitespace.\n";
  70       ok 1;
  71       next;
  72     } else {
  73
  74       my $x = $outstring ^ $compstring;
  75       $x =~ m/^(\x00*)/s or die;
  76       my $at = length($1);
  77       print "# Difference at byte $at...\n";
  78       if($at > 10) {
  79         $at -= 5;
  80       }
  81       {
  82         print "# ", substr($outstring,$at,20), "\n";
  83         print "# ", substr($compstring,$at,20), "\n";
  84         print "#      ^...";
  85       }
  86
  87       ok 0;
  88       printf "# Unequal lengths %s and %s\n", length($outstring), length($compstring);
  89       next;
  90     }
  91   }