xref: /openbsd-src/gnu/usr.bin/perl/cpan/Pod-Simple/t/corpus.t (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c) 
1# Testing a corpus of Pod files
2BEGIN {
3    if($ENV{PERL_CORE}) {
4        chdir 't';
5        @INC = '../lib';
6    }
7
8    use Config;
9    if ($Config::Config{'extensions'} !~ /\bEncode\b/) {
10      print "1..0 # Skip: Encode was not built\n";
11      exit 0;
12    }
13}
14
15#use Pod::Simple::Debug (10);
16use Test qw(plan ok skip);
17
18use File::Spec;
19#use utf8;
20use strict;
21my(@testfiles, %xmlfiles, %wouldxml);
22#use Pod::Simple::Debug (10);
23BEGIN {
24
25sub source_path {
26    my $file = shift;
27    if ($ENV{PERL_CORE}) {
28        require File::Spec;
29        my $updir = File::Spec->updir;
30        my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't');
31        return File::Spec->catdir ($dir, $file);
32    } else {
33        return $file;
34    }
35}
36  my @bits;
37  if(-e( File::Spec::->catdir( @bits =
38    source_path('corpus') ) ) )
39   {
40    # OK
41    print "# 1Bits: @bits\n";
42  } elsif( -e (File::Spec::->catdir( @bits =
43    (File::Spec::->curdir, 'corpus') ) )
44  ) {
45    # OK
46    print "# 2Bits: @bits\n";
47  } elsif ( -e (File::Spec::->catdir( @bits =
48    (File::Spec::->curdir, 't', 'corpus') ) )
49  ) {
50    # OK
51    print "# 3Bits: @bits\n";
52  } else {
53    die "Can't find the corpusdir";
54  }
55  my $corpusdir = File::Spec::->catdir( @bits);
56  print "#Corpusdir: $corpusdir\n";
57
58  opendir(INDIR, $corpusdir) or die "Can't opendir corpusdir : $!";
59  my @f = map File::Spec::->catfile(@bits, $_), readdir(INDIR);
60  closedir(INDIR);
61  my %f;
62  @f{@f} = ();
63  foreach my $maybetest (sort @f) {
64    my $xml = $maybetest;
65    $xml =~ s/\.(txt|pod)$/\.xml/is  or  next;
66    $wouldxml{$maybetest} = $xml;
67    push @testfiles, $maybetest;
68    foreach my $x ($xml, uc($xml), lc($xml)) {
69      next unless exists $f{$x};
70      $xmlfiles{$maybetest} = $x;
71      last;
72    }
73  }
74  die "Too few test files (".@testfiles.")" unless @ARGV or @testfiles > 20;
75
76  @testfiles = @ARGV if @ARGV and !grep !m/\.txt/, @ARGV;
77
78  plan tests => (2 + 2*@testfiles - 1);
79}
80
81my $HACK = 1;
82#@testfiles = ('nonesuch.txt');
83
84ok 1;
85
86my $skippy =  ($] < 5.008) ? "skip because perl ($]) pre-dates v5.8.0" : 0;
87if($skippy) {
88  print "# This is just perl v$], so I'm skipping many many tests.\n";
89}
90
91{
92  my @x = @testfiles;
93  print "# Files to test:\n";
94  while(@x) {  print "#  ", join(' ', splice @x,0,3), "\n" }
95}
96
97require Pod::Simple::DumpAsXML;
98
99
100foreach my $f (@testfiles) {
101  my $xml = $xmlfiles{$f};
102  if($xml) {
103    print "#\n#To test $f against $xml\n";
104  } else {
105    print "#\n# $f has no xml to test it against\n";
106  }
107
108  my $outstring;
109  eval {
110    my $p = Pod::Simple::DumpAsXML->new;
111    $p->output_string( \$outstring );
112    $p->parse_file( $f );
113    undef $p;
114  };
115
116  if($@) {
117    my $x = "#** Couldn't parse $f:\n $@";
118    $x =~ s/([\n\r]+)/\n#** /g;
119    print $x, "\n";
120    ok 0;
121    ok 0;
122    next;
123  } else {
124    print "# OK, parsing $f generated ", length($outstring), " bytes\n";
125    ok 1;
126  }
127
128  die "Null outstring?" unless $outstring;
129
130  next if $f =~ /nonesuch/;
131
132  my $outfilename = ($HACK > 1) ? $wouldxml{$f} : "$wouldxml{$f}\_out";
133  if($HACK) {
134    open OUT, ">$outfilename" or die "Can't write-open $outfilename: $!\n";
135    binmode(OUT);
136    print OUT $outstring;
137    close(OUT);
138  }
139  unless($xml) {
140    print "#  (no comparison done)\n";
141    ok 1;
142    next;
143  }
144
145  open(IN, "<$xml") or die "Can't read-open $xml: $!";
146  #binmode(IN);
147  local $/;
148  my $xmlsource = <IN>;
149  close(IN);
150
151  print "# There's errata!\n" if $outstring =~ m/start_line="-321"/;
152
153  if(
154    $xmlsource eq $outstring
155    or do {
156      $xmlsource =~ s/[\n\r]+/\n/g;
157      $outstring =~ s/[\n\r]+/\n/g;
158      $xmlsource eq $outstring;
159    }
160  ) {
161    print "#  (Perfect match to $xml)\n";
162    unlink $outfilename unless $outfilename =~ m/\.xml$/is;
163    ok 1;
164    next;
165  }
166
167  if($skippy) {
168    skip $skippy, 0;
169  } else {
170    print "#  $outfilename and $xml don't match!\n";
171    print STDERR `diff -u $xml $outfilename`;
172    ok 0;
173  }
174
175}
176
177
178print "#\n# I've been using Encode v",
179  $Encode::VERSION ? $Encode::VERSION : "(NONE)", "\n";
180print "# Byebye\n";
181ok 1;
182print "# --- Done with ", __FILE__, " --- \n";
183
184