xref: /openbsd-src/gnu/usr.bin/perl/cpan/Pod-Simple/t/JustPod_corpus.t (revision 5486feefcc8cb79b19e014ab332cc5dfd05b3b33) 
1# Testing Pod::Simple::JustPod against *.pod in /t
2use strict;
3use warnings;
4
5BEGIN {
6  use Config;
7  if ($Config::Config{'extensions'} !~ /\bEncode\b/) {
8    print "1..0 # Skip: Encode was not built\n";
9    exit 0;
10  }
11}
12
13use File::Find;
14use File::Spec;
15use Test::More;
16
17use Pod::Simple::JustPod;
18
19my @test_files;
20
21BEGIN {
22  my $test_dir = File::Basename::dirname(Cwd::abs_path(__FILE__));
23
24  print "# TESTDIR: $test_dir\n";
25
26  sub wanted {
27    push @test_files, $File::Find::name
28      if $File::Find::name =~ /\.pod$/
29      && $File::Find::name !~ /temp/; # ignore any files named temp,
30                                      # a different test file may have
31                                      # created it
32  }
33  find(\&wanted , $test_dir );
34
35  plan tests => scalar @test_files;
36}
37
38@test_files = sort @test_files;
39
40my @skip_on_windows = qw{
41  corpus/8859_7.pod
42  corpus/laozi38p.pod
43  junk2.pod
44  perlcyg.pod
45  perlfaq.pod
46  perlvar.pod
47  search60/A/x.pod
48  search60/B/X.pod
49  testlib1/hinkhonk/Glunk.pod
50  testlib1/pod/perlflif.pod
51  testlib1/pod/perlthng.pod
52  testlib1/squaa/Glunk.pod
53  testlib1/zikzik.pod
54  testlib2/hinkhonk/Glunk.pod
55  testlib2/pod/perlthng.pod
56  testlib2/pod/perlzuk.pod
57  testlib2/pods/perlzoned.pod
58  testlib2/squaa/Wowo.pod
59};
60
61my $is_windows = $^O eq 'MSWin32';
62foreach my $file (@test_files) {
63  SKIP: {
64    if ( $is_windows ) {
65        my $check_path = join '/', File::Spec->splitdir($file);
66        if (grep { $check_path =~ m{/\Q$_\E\z} } @skip_on_windows ) {
67            skip "$file needs investigation on windows", 1;
68        }
69    }
70
71    my $parser = Pod::Simple::JustPod->new();
72    $parser->complain_stderr(0);
73
74    my $input;
75    open( IN , '<:raw' , $file ) or die "$file: $!";
76    $input .= $_ while (<IN>);
77    close( IN );
78
79    my $output;
80    $parser->output_string( \$output );
81    $parser->parse_string_document( $input );
82
83    if ($parser->any_errata_seen()) {
84      pass("Skip '$file' because of pod errors");
85      next if "$]" lt '5.010.001';     # note() not found in earlier versions
86      my $errata = $parser->errata_seen();
87      foreach my $line_number (sort { $a <=> $b } keys %$errata) {
88          foreach my $err_msg (sort @{$errata->{$line_number}}) {
89              note("$file: $line_number: $err_msg");
90          }
91      }
92      next;
93    }
94
95    my $encoding = $parser->encoding();
96    if (defined $encoding) {
97      eval { require Encode; };
98      $input = Encode::decode($parser->encoding(), $input);
99    }
100
101    my @input = split "\n", $input;
102    my $stripped_input = "";
103    while (defined ($_ = shift @input)) {
104      if (/ ^ = [a-z]+ /x) {
105        my $line = "$_\n";
106
107        if ($stripped_input eq "" || $_ !~ /^=pod/) {
108          $stripped_input .= $line;
109        }
110        while (defined ($_ = shift @input)) {
111          $stripped_input .= "$_\n";
112          last if / ^ =cut /x;
113        }
114      }
115    }
116    $stripped_input =~ s/ ^ =cut \n (.) /$1/mgx;
117
118    $input = $stripped_input if $stripped_input ne "";
119    if ($input !~ / ^ =pod /x) {
120      $input =~ s/ ^ \s+ //x;
121      $input = "=pod\n\n$input";
122    }
123    if ($input !~ / =cut $ /x) {
124      $input =~ s/ \s+ $ //x;
125      $input .= "\n\n=cut\n";
126    }
127
128    my $msg = "got expected output for $file";
129    if ($output eq $input) {
130        pass($msg);
131    }
132    elsif ($ENV{PERL_TEST_DIFF}) {
133      fail($msg);
134      require File::Temp;
135      my $orig_file = File::Temp->new();
136      local $/ = "\n";
137      chomp $input;
138      print $orig_file $input, "\n";
139      close $orig_file || die "Can't close orig_file: $!";
140
141      chomp $output;
142      my $parsed_file = File::Temp->new();
143      print $parsed_file $output, "\n";
144      close $parsed_file || die "Can't close parsed_file";
145
146      my $diff = File::Temp->new();
147      system("$ENV{PERL_TEST_DIFF} $orig_file $parsed_file > $diff");
148
149      open my $fh, "<", $diff || die "Can't open $diff";
150      my @diffs = <$fh>;
151      diag(@diffs);
152    }
153    else {
154        eval { require Text::Diff; };
155        if ($@) {
156            is($output, $input, $msg);
157            diag("Set environment variable PERL_TEST_DIFF=diff_tool or install"
158               . " Text::Diff to see just the differences.");
159        }
160        else {
161            fail($msg);
162            diag Text::Diff::diff(\$input, \$output, { STYLE => 'Unified' });
163        }
164    }
165  }
166}
167