Move Pod::Parser from ext/ to cpan/
[perl.git] / ext / 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   }