Commit | Line | Data |
4f90f8a5 |
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 |
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 | } |