lib/Pod/t/Usage.t

   1 #!perl
   2 use strict;
   3 BEGIN {
   4         chdir 't' if -d 't';
   5         @INC = '../lib';
   6 }
   7
   8 use File::Basename;
   9 use File::Spec;
  10 use Test::More;
  11 plan tests => 8;
  12
  13 use_ok( 'Pod::Usage' );
  14
  15 # Test verbose level 0
  16 my $vbl_0 = << 'EOMSG';
  17 Usage:
  18     The SYNOPSIS section is displayed with -verbose >= 0.
  19
  20 EOMSG
  21 my $fake_out = tie *FAKEOUT, 'CatchOut';
  22 pod2usage({ -verbose => 0, -exit => 'noexit', -output => \*FAKEOUT });
  23 is( $$fake_out, $vbl_0, 'Verbose level 0' );
  24
  25 my $msg = "Prefix message for pod2usage()";
  26 $$fake_out = '';
  27 pod2usage({ -verbose => 0, -exit => 'noexit', -output => \*FAKEOUT,
  28             -message => $msg });
  29 is( $$fake_out, "$msg\n$vbl_0", '-message parameter' );
  30
  31 SKIP: {
  32     my( $file, $path ) = fileparse( $0 );
  33     skip( 'File in current directory', 2 ) if -e $file;
  34     $$fake_out = '';
  35     eval {
  36         pod2usage({ -verbose => 0, -exit => 'noexit',
  37                     -output => \*FAKEOUT, -input => $file });
  38     };
  39     like( $@, qr/^Can't open $file/,
  40           'File not found without -pathlist' );
  41
  42     eval {
  43         pod2usage({ -verbose => 0, -exit => 'noexit',
  44                     -output => \*FAKEOUT, -input => $file,
  45                     -pathlist => $path });
  46     };
  47     is( $$fake_out, $vbl_0, '-pathlist parameter' );
  48 }
  49
  50 SKIP: { # Test exit status from pod2usage()
  51     skip "Exit status broken on Mac OS", 1 if $^O eq 'MacOS';
  52     my $exit = ($^O eq 'VMS' ? 2 : 42);
  53     my $dev_null = File::Spec->devnull;
  54     my $args = join ", ", (
  55         "-verbose => 0",
  56         "-exit    => $exit",
  57         "-output  => q{$dev_null}",
  58         "-input   => q{$0}",
  59     );
  60     my $cq = (($^O eq 'MSWin32'
  61                || $^O eq 'NetWare'
  62                || $^O eq 'VMS') ? '"'
  63               : "");
  64     my @params = ( "${cq}-I../lib$cq",  "${cq}-MPod::Usage$cq", '-e' );
  65     my $prg = qq[${cq}pod2usage({ $args })$cq];
  66     my @cmd = ( $^X, @params, $prg );
  67
  68     print "# cmd = @cmd\n";
  69
  70     is( system( @cmd ) >> 8, $exit, 'Exit status of pod2usage()' );
  71 }
  72
  73 # Test verbose level 1
  74 my $vbl_1 = << 'EOMSG';
  75 Usage:
  76     The SYNOPSIS section is displayed with -verbose >= 0.
  77
  78 Options:
  79     The OPTIONS section is displayed with -verbose >= 1.
  80
  81 Arguments:
  82     The ARGUMENTS section is displayed with -verbose >= 1.
  83
  84 EOMSG
  85 $$fake_out = '';
  86 pod2usage( { -verbose => 1, -exit => 'noexit', -output => \*FAKEOUT } );
  87 is( $$fake_out, $vbl_1, 'Verbose level 1' );
  88
  89 # Test verbose level 2
  90 $$fake_out = '';
  91 require Pod::Text; # Pod::Usage->isa( 'Pod::Text' )
  92
  93 ( my $p2tp = new Pod::Text )->parse_from_file( $0, \*FAKEOUT );
  94 my $pod2text = $$fake_out;
  95
  96 $$fake_out = '';
  97 pod2usage( { -verbose => 2, -exit => 'noexit', -output => \*FAKEOUT } );
  98 my $pod2usage = $$fake_out;
  99
 100 is( $pod2usage, $pod2text, 'Verbose level >= 2 eq pod2text' );
 101
 102
 103 package CatchOut;
 104 sub TIEHANDLE { bless \( my $self ), shift }
 105 sub PRINT     { my $self = shift; $$self .= $_[0] }
 106
 107 __END__
 108
 109 =head1 NAME
 110
 111 Usage.t - Tests for Pod::Usage
 112
 113 =head1 SYNOPSIS
 114
 115 The B<SYNOPSIS> section is displayed with -verbose >= 0.
 116
 117 =head1 DESCRIPTION
 118
 119 Testing Pod::Usage. This section is not displayed with -verbose < 2.
 120
 121 =head1 OPTIONS
 122
 123 The B<OPTIONS> section is displayed with -verbose >= 1.
 124
 125 =head1 ARGUMENTS
 126
 127 The B<ARGUMENTS> section is displayed with -verbose >= 1.
 128
 129 =head1 AUTHOR
 130
 131 20020105 Abe Timmerman <abe@ztreet.demon.nl>
 132
 133 =cut