xref: /openbsd/gnu/usr.bin/perl/cpan/Pod-Simple/t/reinit.t (revision 4bdff4be)
1BEGIN {
2    chdir 't' if -d 't';
3    if($ENV{PERL_CORE}) {
4        @INC = '../lib';
5    }
6}
7
8use lib '../lib';
9
10use strict;
11use warnings;
12use Test;
13BEGIN { plan tests => 5 };
14
15sub source_path {
16    my $file = shift;
17    if ($ENV{PERL_CORE}) {
18        require File::Spec;
19        my $updir = File::Spec->updir;
20        my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 'Simple', 't');
21        return File::Spec->catfile ($dir, $file);
22    } else {
23        return $file;
24    }
25}
26
27use Pod::Simple::Text;
28$Pod::Simple::Text::FREAKYMODE = 1;
29
30my $parser  = Pod::Simple::Text->new();
31
32foreach my $file (
33  "junk1.pod",
34  "junk2.pod",
35  "perlcyg.pod",
36  "perlfaq.pod",
37  "perlvar.pod",
38) {
39
40  unless(-e source_path($file)) {
41    ok 0;
42    print "# But $file doesn't exist!!\n";
43    next;
44  }
45
46    my $precooked = $file;
47    my $outstring;
48    my $compstring;
49    $precooked =~ s<\.pod><o.txt>s;
50    $parser->reinit;
51    $parser->output_string(\$outstring);
52    $parser->parse_file(source_path($file));
53
54    open(IN, $precooked) or die "Can't read-open $precooked: $!";
55    {
56      local $/;
57      $compstring = <IN>;
58    }
59    close(IN);
60
61    for ($outstring,$compstring) { s/\s+/ /g; s/^\s+//s; s/\s+$//s; }
62
63    if($outstring eq $compstring) {
64      ok 1;
65      next;
66    } elsif( do{
67      for ($outstring, $compstring) { tr/ //d; };
68      $outstring eq $compstring;
69    }){
70      print "# Differ only in whitespace.\n";
71      ok 1;
72      next;
73    } else {
74
75      my $x = $outstring ^ $compstring;
76      $x =~ m/^(\x00*)/s or die;
77      my $at = length($1);
78      print "# Difference at byte $at...\n";
79      if($at > 10) {
80        $at -= 5;
81      }
82      {
83        print "# ", substr($outstring,$at,20), "\n";
84        print "# ", substr($compstring,$at,20), "\n";
85        print "#      ^...";
86      }
87
88      ok 0;
89      printf "# Unequal lengths %s and %s\n", length($outstring), length($compstring);
90      next;
91    }
92  }
93