cpan/podlators/t/man-options.t

   1 #!/usr/bin/perl -w
   2 #
   3 # man-options.t -- Additional tests for Pod::Man options.
   4 #
   5 # Copyright 2002, 2004, 2006, 2008, 2009 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 => 10;
  22 BEGIN { use_ok ('Pod::Man') }
  23
  24 # Redirect stderr to a file.
  25 sub stderr_save {
  26     open (OLDERR, '>&STDERR') or die "Can't dup STDERR: $!\n";
  27     open (STDERR, '> out.err') or die "Can't redirect STDERR: $!\n";
  28 }
  29
  30 # Restore stderr.
  31 sub stderr_restore {
  32     close STDERR;
  33     open (STDERR, '>&OLDERR') or die "Can't dup STDERR: $!\n";
  34     close OLDERR;
  35 }
  36
  37 my $n = 1;
  38 while (<DATA>) {
  39     my %options;
  40     next until $_ eq "###\n";
  41     while (<DATA>) {
  42         last if $_ eq "###\n";
  43         my ($option, $value) = split;
  44         $options{$option} = $value;
  45     }
  46     open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n";
  47     while (<DATA>) {
  48         last if $_ eq "###\n";
  49         print TMP $_;
  50     }
  51     close TMP;
  52     my $parser = Pod::Man->new (%options);
  53     isa_ok ($parser, 'Pod::Man', 'Parser object');
  54     open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n";
  55     stderr_save;
  56     $parser->parse_from_file ('tmp.pod', \*OUT);
  57     stderr_restore;
  58     close OUT;
  59     my $accents = 0;
  60     open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n";
  61     while (<TMP>) {
  62         last if /^\.nh/;
  63     }
  64     my $output;
  65     {
  66         local $/;
  67         $output = <TMP>;
  68     }
  69     close TMP;
  70     1 while unlink ('tmp.pod', 'out.tmp');
  71     my $expected = '';
  72     while (<DATA>) {
  73         last if $_ eq "###\n";
  74         $expected .= $_;
  75     }
  76     is ($output, $expected, "Output correct for test $n");
  77     open (ERR, 'out.err') or die "Cannot open out.err: $!\n";
  78     my $errors;
  79     {
  80         local $/;
  81         $errors = <ERR>;
  82     }
  83     close ERR;
  84     1 while unlink ('out.err');
  85     $expected = '';
  86     while (<DATA>) {
  87         last if $_ eq "###\n";
  88         $expected .= $_;
  89     }
  90     is ($errors, $expected, "Errors are correct for test $n");
  91     $n++;
  92 }
  93
  94 # Below the marker are bits of POD and corresponding expected text output and
  95 # error output.  This is used to test specific features or problems with
  96 # Pod::Man.  The options, input, output, and errors are separated by lines
  97 # containing only ###.
  98
  99 __DATA__
 100
 101 ###
 102 fixed CR
 103 fixedbold CY
 104 fixeditalic CW
 105 fixedbolditalic CX
 106 ###
 107 =head1 FIXED FONTS
 108
 109 C<foo B<bar I<baz>> I<bay>>
 110 ###
 111 .SH "FIXED FONTS"
 112 .IX Header "FIXED FONTS"
 113 \&\f(CR\*(C`foo \f(CYbar \f(CXbaz\f(CY\f(CR \f(CWbay\f(CR\*(C'\fR
 114 ###
 115 ###
 116
 117 ###
 118 ###
 119 =over 4
 120
 121 =item Foo
 122
 123 Bar.
 124
 125 =head1 NEXT
 126 ###
 127 .IP "Foo" 4
 128 .IX Item "Foo"
 129 Bar.
 130 .SH "NEXT"
 131 .IX Header "NEXT"
 132 .SH "POD ERRORS"
 133 .IX Header "POD ERRORS"
 134 Hey! \fBThe above document had some coding errors, which are explained below:\fR
 135 .IP "Around line 7:" 4
 136 .IX Item "Around line 7:"
 137 You forgot a '=back' before '=head1'
 138 ###
 139 ###
 140
 141 ###
 142 stderr 1
 143 ###
 144 =over 4
 145
 146 =item Foo
 147
 148 Bar.
 149
 150 =head1 NEXT
 151 ###
 152 .IP "Foo" 4
 153 .IX Item "Foo"
 154 Bar.
 155 .SH "NEXT"
 156 .IX Header "NEXT"
 157 ###
 158 tmp.pod around line 7: You forgot a '=back' before '=head1'
 159 ###