vcs.maemo.org Git - dh-make-perl/blob - dev/arm/libpod-simple-perl/libpod-simple-perl-3.07/t/render.t

   1 BEGIN {
   2     if($ENV{PERL_CORE}) {
   3         chdir 't';
   4         @INC = '../lib';
   5     } else {
   6         push @INC, '../lib';
   7     }
   8 }
   9
  10 use strict;
  11 use Test;
  12 BEGIN { plan tests => 26 };
  13 use Pod::Simple::TextContent;
  14 use Pod::Simple::Text;
  15
  16 BEGIN {
  17   *mytime = defined(&Win32::GetTickCount)
  18     ? sub () {Win32::GetTickCount() / 1000}
  19     : sub () {time()}
  20 }
  21
  22 $Pod::Simple::Text::FREAKYMODE = 1;
  23 use Pod::Simple::TiedOutFH ();
  24
  25 chdir 't' unless $ENV{PERL_CORE};
  26
  27 sub source_path {
  28     my $file = shift;
  29     if ($ENV{PERL_CORE}) {
  30         require File::Spec;
  31         my $updir = File::Spec->updir;
  32         my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 'Simple', 't');
  33         return File::Spec->catfile ($dir, $file);
  34     } else {
  35         return $file;
  36     }
  37 }
  38
  39 my $outfile = '10000';
  40
  41 foreach my $file (
  42   "junk1.pod",
  43   "junk2.pod",
  44   "perlcyg.pod",
  45   "perlfaq.pod",
  46   "perlvar.pod",
  47 ) {
  48
  49   unless(-e source_path($file)) {
  50     ok 0;
  51     print "# But $file doesn't exist!!\n";
  52     exit 1;
  53   }
  54
  55   my @out;
  56   my $precooked = source_path($file);
  57   $precooked =~ s<\.pod><o.txt>s;
  58   unless(-e $precooked) {
  59     ok 0;
  60     print "# But $precooked doesn't exist!!\n";
  61     exit 1;
  62   }
  63
  64   print "#\n#\n#\n###################\n# $file\n";
  65   foreach my $class ('Pod::Simple::TextContent', 'Pod::Simple::Text') {
  66     my $p = $class->new;
  67     push @out, '';
  68     $p->output_string(\$out[-1]);
  69     my $t = mytime();
  70     $p->parse_file(source_path($file));
  71     printf "# %s %s %sb, %.03fs\n",
  72      ref($p), source_path($file), length($out[-1]), mytime() - $t ;
  73     ok 1;
  74   }
  75
  76   print "# Reading $precooked...\n";
  77   open(IN, $precooked) or die "Can't read-open $precooked: $!";
  78   {
  79     local $/;
  80     push @out, <IN>;
  81   }
  82   close(IN);
  83   print "#   ", length($out[-1]), " bytes pulled in.\n";
  84
  85
  86   for (@out) { s/\s+/ /g; s/^\s+//s; s/\s+$//s; }
  87
  88   my $faily = 0;
  89   print "#\n#Now comparing 1 and 2...\n";
  90   $faily += compare2($out[0], $out[1]);
  91   print "#\n#Now comparing 2 and 3...\n";
  92   $faily += compare2($out[1], $out[2]);
  93   print "#\n#Now comparing 1 and 3...\n";
  94   $faily += compare2($out[0], $out[2]);
  95
  96   if($faily) {
  97     ++$outfile;
  98
  99     my @outnames = map $outfile . $_ , qw(0 1);
 100     open(OUT2, ">$outnames[0].~out.txt") || die "Can't write-open $outnames[0].txt: $!";
 101
 102     foreach my $out (@out) { push @outnames, $outnames[-1];  ++$outnames[-1] };
 103     pop @outnames;
 104     printf "# Writing to %s.txt .. %s.txt\n", $outnames[0], $outnames[-1];
 105     shift @outnames;
 106
 107     binmode(OUT2);
 108     foreach my $out (@out) {
 109       my $outname = shift @outnames;
 110       open(OUT, ">$outname.txt") || die "Can't write-open $outname.txt: $!";
 111       binmode(OUT);
 112       print OUT  $out, "\n";
 113       print OUT2 $out, "\n";
 114       close(OUT);
 115     }
 116     close(OUT2);
 117   }
 118 }
 119
 120 print "# Wrapping up... one for the road...\n";
 121 ok 1;
 122 print "# --- Done with ", __FILE__, " --- \n";
 123 exit;
 124
 125
 126 sub compare2 {
 127   my @out = @_;
 128   if($out[0] eq $out[1]) {
 129     ok 1;
 130     return 0;
 131   } elsif( do{
 132     for ($out[0], $out[1]) { tr/ //d; };
 133     $out[0] eq $out[1];
 134   }){
 135     print "# Differ only in whitespace.\n";
 136     ok 1;
 137     return 0;
 138   } else {
 139     #ok $out[0], $out[1];
 140
 141     my $x = $out[0] ^ $out[1];
 142     $x =~ m/^(\x00*)/s or die;
 143     my $at = length($1);
 144     print "# Difference at byte $at...\n";
 145     if($at > 10) {
 146       $at -= 5;
 147     }
 148     {
 149       print "# ", substr($out[0],$at,20), "\n";
 150       print "# ", substr($out[1],$at,20), "\n";
 151       print "#      ^...";
 152     }
 153
 154
 155
 156     ok 0;
 157     printf "# Unequal lengths %s and %s\n", length($out[0]), length($out[1]);
 158     return 1;
 159   }
 160 }
 161
 162
 163 __END__
 164