cpan/podlators/t/basic.t

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