lib/Pod/t/basic.t

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