ae7b8f401d4bee0f35bf3c7737d1d400dfac0014
[perl.git] / ext / Pod-Simple / 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