xref: /openbsd-src/gnu/usr.bin/perl/cpan/Pod-Simple/t/corpus.t (revision e0a5400065cea17a7de6532c2ecb091c5f17622b) 
1# Testing a corpus of Pod files
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    if (ord("A") != 65) {
12      print "1..0 # Skip: Encode not fully working on non-ASCII platforms at this time\n";
13      exit 0;
14    }
15}
16
17#use Pod::Simple::Debug (10);
18use Test::More;
19
20use File::Spec;
21use Cwd ();
22use File::Basename ();
23
24my(@testfiles, %xmlfiles, %wouldxml);
25#use Pod::Simple::Debug (10);
26BEGIN {
27  my $corpusdir = File::Spec->catdir(File::Basename::dirname(File::Spec->rel2abs(__FILE__)), 'corpus');
28  print "#Corpusdir: $corpusdir\n";
29
30  opendir(INDIR, $corpusdir) or die "Can't opendir corpusdir : $!";
31  my @f = map File::Spec::->catfile($corpusdir, $_), readdir(INDIR);
32  closedir(INDIR);
33  my %f;
34  @f{@f} = ();
35  foreach my $maybetest (sort @f) {
36    my $xml = $maybetest;
37    $xml =~ s/\.(txt|pod)$/\.xml/is  or  next;
38    $wouldxml{$maybetest} = $xml;
39    push @testfiles, $maybetest;
40    foreach my $x ($xml, uc($xml), lc($xml)) {
41      next unless exists $f{$x};
42      $xmlfiles{$maybetest} = $x;
43      last;
44    }
45  }
46  die "Too few test files (".@testfiles.")" unless @ARGV or @testfiles > 20;
47
48  @testfiles = @ARGV if @ARGV and !grep !m/\.txt/, @ARGV;
49
50  plan tests => (2*@testfiles - 1);
51}
52
53my $HACK = 1;
54#@testfiles = ('nonesuch.txt');
55
56my $skippy =  ($] < 5.008) ? "skip because perl ($]) pre-dates v5.8.0" : 0;
57if($skippy) {
58  print "# This is just perl v$], so I'm skipping many many tests.\n";
59}
60
61{
62  my @x = @testfiles;
63  print "# Files to test:\n";
64  while(@x) {  print "#  ", join(' ', splice @x,0,3), "\n" }
65}
66
67require Pod::Simple::DumpAsXML;
68
69
70foreach my $f (@testfiles) {
71  my $xml = $xmlfiles{$f};
72  if($xml) {
73    print "#\n#To test $f against $xml\n";
74  } else {
75    print "#\n# $f has no xml to test it against\n";
76  }
77
78  my $outstring;
79  eval {
80    my $p = Pod::Simple::DumpAsXML->new;
81    $p->output_string( \$outstring );
82    $p->parse_file( $f );
83    undef $p;
84  };
85
86  if($@) {
87    my $x = "#** Couldn't parse $f:\n $@";
88    $x =~ s/([\n\r]+)/\n#** /g;
89    print $x, "\n";
90    ok 0;
91    ok 0;
92    next;
93  } else {
94    print "# OK, parsing $f generated ", length($outstring), " bytes\n";
95    ok 1;
96  }
97
98  die "Null outstring?" unless $outstring;
99
100  next if $f =~ /nonesuch/;
101
102  my $outfilename = ($HACK > 1) ? $wouldxml{$f} : "$wouldxml{$f}\_out";
103  if($HACK) {
104    open OUT, ">$outfilename" or die "Can't write-open $outfilename: $!\n";
105    binmode(OUT);
106    print OUT $outstring;
107    close(OUT);
108  }
109  unless($xml) {
110    print "#  (no comparison done)\n";
111    ok 1;
112    next;
113  }
114
115  open(IN, "<$xml") or die "Can't read-open $xml: $!";
116  #binmode(IN);
117  local $/;
118  my $xmlsource = <IN>;
119  close(IN);
120
121  print "# There's errata!\n" if $outstring =~ m/start_line="-321"/;
122
123  if(
124    $xmlsource eq $outstring
125    or do {
126      $xmlsource =~ s/[\n\r]+/\n/g;
127      $outstring =~ s/[\n\r]+/\n/g;
128      $xmlsource eq $outstring;
129    }
130  ) {
131    print "#  (Perfect match to $xml)\n";
132    unlink $outfilename unless $outfilename =~ m/\.xml$/is;
133    ok 1;
134    next;
135  }
136
137  if($skippy) {
138    skip $skippy, 0;
139  } else {
140    print STDERR "#  $outfilename and $xml don't match!\n";
141    print STDERR `diff $xml $outfilename`;
142    ok 0;
143  }
144
145}
146