lib/Pod/t/basic.t

   1 #!/usr/bin/perl -w
   2 #
   3 # basic.t -- Basic tests for podlators.
   4 #
   5 # Copyright 2001, 2002, 2004, 2006 by Russ Allbery <rra@stanford.edu>
   6 #
   7 # This program is free software; you may redistribute it and/or modify it
   8 # under the same terms as Perl itself.
   9
  10 BEGIN {
  11     chdir 't' if -d 't';
  12     if ($ENV{PERL_CORE}) {
  13         @INC = '../lib';
  14     } else {
  15         unshift (@INC, '../blib/lib');
  16     }
  17     unshift (@INC, '../blib/lib');
  18     $| = 1;
  19     print "1..11\n";
  20 }
  21
  22 END {
  23     print "not ok 1\n" unless $loaded;
  24 }
  25
  26 use Pod::Man;
  27 use Pod::Text;
  28 use Pod::Text::Overstrike;
  29 use Pod::Text::Termcap;
  30
  31 # Find the path to the test source files.  This requires some fiddling when
  32 # these tests are run as part of Perl core.
  33 sub source_path {
  34     my $file = shift;
  35     if ($ENV{PERL_CORE}) {
  36         require File::Spec;
  37         my $updir = File::Spec->updir;
  38         my $dir = File::Spec->catdir ($updir, 'lib', 'Pod', 't');
  39         return File::Spec->catfile ($dir, $file);
  40     } else {
  41         return $file;
  42     }
  43 }
  44
  45 $loaded = 1;
  46 print "ok 1\n";
  47
  48 # Hard-code a few values to try to get reproducible results.
  49 $ENV{COLUMNS} = 80;
  50 $ENV{TERM} = 'xterm';
  51 $ENV{TERMCAP} = 'xterm:co=80:do=^J:md=\E[1m:us=\E[4m:me=\E[m';
  52
  53 # Map of translators to file extensions to find the formatted output to
  54 # compare against.
  55 my %translators = ('Pod::Man'              => 'man',
  56                    'Pod::Text'             => 'txt',
  57                    'Pod::Text::Color'      => 'clr',
  58                    'Pod::Text::Overstrike' => 'ovr',
  59                    'Pod::Text::Termcap'    => 'cap');
  60
  61 # Set default options to match those of pod2man and pod2text.
  62 %options = (sentence => 0);
  63
  64 my $n = 2;
  65 for (sort keys %translators) {
  66     if ($_ eq 'Pod::Text::Color') {
  67         eval { require Term::ANSIColor };
  68         if ($@) {
  69             print "ok $n # skip\n";
  70             $n++;
  71             print "ok $n # skip\n";
  72             $n++;
  73             next;
  74         }
  75         require Pod::Text::Color;
  76     }
  77     my $parser = $_->new (%options);
  78     print (($parser && ref ($parser) eq $_) ? "ok $n\n" : "not ok $n\n");
  79     $n++;
  80
  81     # For Pod::Man, strip out the autogenerated header up to the .TH title
  82     # line.  That means that we don't check those things; oh well.  The header
  83     # changes with each version change or touch of the input file.
  84     open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
  85     $parser->parse_from_file (source_path ('basic.pod'), \*OUT);
  86     close OUT;
  87     if ($_ eq 'Pod::Man') {
  88         open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n";
  89         open (OUTPUT, "> out.$translators{$_}")
  90             or die "Cannot create out.$translators{$_}: $!\n";
  91         local $_;
  92         while (<TMP>) { last if /^\.nh/ }
  93         print OUTPUT while <TMP>;
  94         close OUTPUT;
  95         close TMP;
  96         unlink 'out.tmp';
  97     } else {
  98         rename ('out.tmp', "out.$translators{$_}")
  99             or die "Cannot rename out.tmp: $!\n";
 100     }
 101     {
 102         local $/;
 103         open (MASTER, source_path ("basic.$translators{$_}"))
 104             or die "Cannot open basic.$translators{$_}: $!\n";
 105         open (OUTPUT, "out.$translators{$_}")
 106             or die "Cannot open out.$translators{$_}: $!\n";
 107         my $master = <MASTER>;
 108         my $output = <OUTPUT>;
 109         close MASTER;
 110         close OUTPUT;
 111
 112         # OS/390 is EBCDIC, which uses a different character for ESC
 113         # apparently.  Try to convert so that the test still works.
 114         if ($^O eq 'os390' && $_ eq 'Pod::Text::Termcap') {
 115             $output =~ tr/\033/\047/;
 116         }
 117
 118         if ($master eq $output) {
 119             print "ok $n\n";
 120             unlink "out.$translators{$_}";
 121         } else {
 122             print "not ok $n\n";
 123             print "# Non-matching output left in out.$translators{$_}\n";
 124         }
 125     }
 126     $n++;
 127 }