Commit | Line | Data |
---|---|---|
4f90f8a5 SP |
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 | ||
9d65762f | 45 | my $precooked = $file; |
4f90f8a5 SP |
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 | } |