t/pod/pod2usage2.t

   1 #!/usr/bin/perl -w
   2
   3 use Test::More;
   4
   5 BEGIN {
   6   if ($^O eq 'MSWin32' || $^O eq 'VMS') {
   7     plan skip_all => "Not portable on Win32 or VMS\n";
   8   }
   9   else {
  10     plan tests => 34;
  11   }
  12   use_ok ("Pod::Usage");
  13 }
  14
  15 sub getoutput
  16 {
  17   my ($code) = @_;
  18   my $pid = open(TEST_IN, "-|");
  19   unless(defined $pid) {
  20     die "Cannot fork: $!";
  21   }
  22   if($pid) {
  23     # parent
  24     my @out = <TEST_IN>;
  25     close(TEST_IN);
  26     my $exit = $?>>8;
  27     s/^/#/ for @out;
  28     local $" = "";
  29     print "#EXIT=$exit OUTPUT=+++#@out#+++\n";
  30     return($exit, join("",@out));
  31   }
  32   # child
  33   open(STDERR, ">&STDOUT");
  34   Test::More->builder->no_ending(1);
  35   &$code;
  36   print "--NORMAL-RETURN--\n";
  37   exit 0;
  38 }
  39
  40 sub compare
  41 {
  42   my ($left,$right) = @_;
  43   $left  =~ s/^#\s+/#/gm;
  44   $right =~ s/^#\s+/#/gm;
  45   $left  =~ s/\s+/ /gm;
  46   $right =~ s/\s+/ /gm;
  47   $left eq $right;
  48 }
  49
  50 SKIP: {
  51 if('Pod::Usage'->isa('Pod::Text') && $Pod::Text::VERSION < 2.18) {
  52   skip("Formatting with Pod::Text $Pod::Text::VERSION not reliable", 33);
  53 }
  54
  55 my ($exit, $text) = getoutput( sub { pod2usage() } );
  56 is ($exit, 2,                 "Exit status pod2usage ()");
  57 ok (compare ($text, <<'EOT'), "Output test pod2usage ()");
  58 #Usage:
  59 #    frobnicate [ -r | --recursive ] [ -f | --force ] file ...
  60 #
  61 EOT
  62
  63 ($exit, $text) = getoutput( sub { pod2usage(
  64   -message => 'You naughty person, what did you say?',
  65   -verbose => 1 ) });
  66 is ($exit, 1,                 "Exit status pod2usage (-message => '...', -verbose => 1)");
  67 ok (compare ($text, <<'EOT'), "Output test pod2usage (-message => '...', -verbose => 1)") or diag("Got:\n$text\n");
  68 #You naughty person, what did you say?
  69 # Usage:
  70 #     frobnicate [ -r | --recursive ] [ -f | --force ] file ...
  71 #
  72 # Options:
  73 #     -r | --recursive
  74 #         Run recursively.
  75 #
  76 #     -f | --force
  77 #         Just do it!
  78 #
  79 #     -n number
  80 #         Specify number of frobs, default is 42.
  81 #
  82 EOT
  83
  84 ($exit, $text) = getoutput( sub { pod2usage(
  85   -verbose => 2, -exit => 42 ) } );
  86 is ($exit, 42,                "Exit status pod2usage (-verbose => 2, -exit => 42)");
  87 ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -exit => 42)");
  88 #NAME
  89 #     frobnicate - do what I mean
  90 #
  91 # SYNOPSIS
  92 #     frobnicate [ -r | --recursive ] [ -f | --force ] file ...
  93 #
  94 # DESCRIPTION
  95 #     frobnicate does foo and bar and what not.
  96 #
  97 # OPTIONS
  98 #     -r | --recursive
  99 #         Run recursively.
 100 #
 101 #     -f | --force
 102 #         Just do it!
 103 #
 104 #     -n number
 105 #         Specify number of frobs, default is 42.
 106 #
 107 EOT
 108
 109 ($exit, $text) = getoutput( sub { pod2usage(0) } );
 110 is ($exit, 0,                 "Exit status pod2usage (0)");
 111 ok (compare ($text, <<'EOT'), "Output test pod2usage (0)");
 112 #Usage:
 113 #     frobnicate [ -r | --recursive ] [ -f | --force ] file ...
 114 #
 115 # Options:
 116 #     -r | --recursive
 117 #         Run recursively.
 118 #
 119 #     -f | --force
 120 #         Just do it!
 121 #
 122 #     -n number
 123 #         Specify number of frobs, default is 42.
 124 #
 125 EOT
 126
 127 ($exit, $text) = getoutput( sub { pod2usage(42) } );
 128 is ($exit, 42,                "Exit status pod2usage (42)");
 129 ok (compare ($text, <<'EOT'), "Output test pod2usage (42)");
 130 #Usage:
 131 #     frobnicate [ -r | --recursive ] [ -f | --force ] file ...
 132 #
 133 EOT
 134
 135 ($exit, $text) = getoutput( sub { pod2usage(-verbose => 0, -exit => 'NOEXIT') } );
 136 is ($exit, 0,                 "Exit status pod2usage (-verbose => 0, -exit => 'NOEXIT')");
 137 ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 0, -exit => 'NOEXIT')");
 138 #Usage:
 139 #     frobnicate [ -r | --recursive ] [ -f | --force ] file ...
 140 #
 141 # --NORMAL-RETURN--
 142 EOT
 143
 144 ($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION') } );
 145 is ($exit, 1,                 "Exit status pod2usage (-verbose => 99, -sections => 'DESCRIPTION')");
 146 ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 99, -sections => 'DESCRIPTION')");
 147 #Description:
 148 #     frobnicate does foo and bar and what not.
 149 #
 150 EOT
 151
 152 # does the __DATA__ work ok as input
 153 ($exit, $text) = getoutput( sub { system($^X, '-Mblib', File::Spec->catfile(qw(t pod p2u_data.pl))); exit($? >> 8); } );
 154 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
 155 is ($exit, 17,                 "Exit status pod2usage (-verbose => 2, -input => \*DATA)");
 156 ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -input => \*DATA)") or diag "Got:\n$text\n";
 157 #NAME
 158 #    Test
 159 #
 160 #SYNOPSIS
 161 #    perl podusagetest.pl
 162 #
 163 #DESCRIPTION
 164 #    This is a test.
 165 #
 166 EOT
 167
 168 # test that SYNOPSIS and USAGE are printed
 169 ($exit, $text) = getoutput( sub { pod2usage(-input => File::Spec->catfile(qw(t pod usage.pod)),
 170                                             -exitval => 0, -verbose => 0); });
 171 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
 172 is ($exit, 0,                 "Exit status pod2usage with USAGE");
 173 ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE") or diag "Got:\n$text\n";
 174 #Usage:
 175 #    This is a test for CPAN#33020
 176 #
 177 #Usage:
 178 #    And this will be also printed.
 179 #
 180 EOT
 181
 182 # test that SYNOPSIS and USAGE are printed with options
 183 ($exit, $text) = getoutput( sub { pod2usage(-input => File::Spec->catfile(qw(t pod usage.pod)),
 184                                             -exitval => 0, -verbose => 1); });
 185 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
 186 is ($exit, 0,                 "Exit status pod2usage with USAGE and verbose=1");
 187 ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=1") or diag "Got:\n$text\n";
 188 #Usage:
 189 #    This is a test for CPAN#33020
 190 #
 191 #Usage:
 192 #    And this will be also printed.
 193 #
 194 #Options:
 195 #    And this with verbose == 1
 196 #
 197 EOT
 198
 199 # test that only USAGE is printed when requested
 200 ($exit, $text) = getoutput( sub { pod2usage(-input => File::Spec->catfile(qw(t pod usage.pod)),
 201                                             -exitval => 0, -verbose => 99, -sections => 'USAGE'); });
 202 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
 203 is ($exit, 0,                 "Exit status pod2usage with USAGE and verbose=99");
 204 ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=99") or diag "Got:\n$text\n";
 205 #Usage:
 206 #    This is a test for CPAN#33020
 207 #
 208 EOT
 209
 210 # test with pod_where
 211 use_ok('Pod::Find', qw(pod_where));
 212 ($exit, $text) = getoutput( sub { pod2usage( -input => pod_where({-inc => 1}, 'Pod::Usage'),
 213                                              -exitval => 0, -verbose => 0) } );
 214 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
 215 is ($exit, 0,                 "Exit status pod2usage with Pod::Find");
 216 ok (compare ($text, <<'EOT'), "Output test pod2usage with Pod::Find") or diag "Got:\n$text\n";
 217 #Usage:
 218 #      use Pod::Usage
 219 #
 220 #      my $message_text  = "This text precedes the usage message.";
 221 #      my $exit_status   = 2;          ## The exit status to use
 222 #      my $verbose_level = 0;          ## The verbose level to use
 223 #      my $filehandle    = \*STDERR;   ## The filehandle to write to
 224 #
 225 #      pod2usage($message_text);
 226 #
 227 #      pod2usage($exit_status);
 228 #
 229 #      pod2usage( { -message => $message_text ,
 230 #                   -exitval => $exit_status  ,
 231 #                   -verbose => $verbose_level,
 232 #                   -output  => $filehandle } );
 233 #
 234 #      pod2usage(   -msg     => $message_text ,
 235 #                   -exitval => $exit_status  ,
 236 #                   -verbose => $verbose_level,
 237 #                   -output  => $filehandle   );
 238 #
 239 #      pod2usage(   -verbose => 2,
 240 #                   -noperldoc => 1  )
 241 #
 242 EOT
 243
 244 # verify that sections are correctly found after nested headings
 245 ($exit, $text) = getoutput( sub { pod2usage(-input => File::Spec->catfile(qw(t pod usage2.pod)),
 246                                             -exitval => 0, -verbose => 99,
 247                                             -sections => [qw(BugHeader BugHeader/.*')]) });
 248 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
 249 is ($exit, 0,                 "Exit status pod2usage with nested headings");
 250 ok (compare ($text, <<'EOT'), "Output test pod2usage with nested headings") or diag "Got:\n$text\n";
 251 #BugHeader:
 252 #    Some text
 253 #
 254 #  BugHeader2:
 255 #    More
 256 #    Still More
 257 #
 258 EOT
 259
 260 # Verify that =over =back work OK
 261 ($exit, $text) = getoutput( sub {
 262   pod2usage(-input => File::Spec->catfile(qw(t pod usage2.pod)),
 263             -exitval => 0, -verbose => 99, -sections => 'BugHeader/BugHeader2') } );
 264 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
 265 is ($exit, 0,                 "Exit status pod2usage with over/back");
 266 ok (compare ($text, <<'EOT'), "Output test pod2usage with over/back") or diag "Got:\n$text\n";
 267 #  BugHeader2:
 268 #    More
 269 #    Still More
 270 #
 271 EOT
 272
 273 # new array API for -sections
 274 ($exit, $text) = getoutput( sub {
 275   pod2usage(-input => File::Spec->catfile(qw(t pod usage2.pod)),
 276             -exitval => 0, -verbose => 99, -sections => [qw(Heading-1/!.+ Heading-2/.+)]) } );
 277 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
 278 is ($exit, 0,                 "Exit status pod2usage with -sections => []");
 279 ok (compare ($text, <<'EOT'), "Output test pod2usage with -sections => []") or diag "Got:\n$text\n";
 280 #Heading-1:
 281 #    One
 282 #    Two
 283 #
 284 #  Heading-2.2:
 285 #    More text.
 286 #
 287 EOT
 288
 289 # allow subheadings in OPTIONS and ARGUMENTS
 290 ($exit, $text) = getoutput( sub {
 291   pod2usage(-input => File::Spec->catfile(qw(t pod usage2.pod)),
 292             -exitval => 0, -verbose => 1) } );
 293 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
 294 $text =~ s{[*](destination|files)[*]}{$1}g; # strip * chars
 295 is ($exit, 0,                 "Exit status pod2usage with subheadings in OPTIONS");
 296 ok (compare ($text, <<'EOT'), "Output test pod2usage with subheadings in OPTIONS") or diag "Got:\n$text\n";
 297 #Options and Arguments:
 298 #  Arguments:
 299 #    The required arguments (which typically follow any options on the
 300 #    command line) are:
 301 #
 302 #    destination
 303 #    files
 304 #
 305 #  Options:
 306 #    Options may be abbreviated. Options which take values may be separated
 307 #    from the values by whitespace or the "=" character.
 308 #
 309 EOT
 310 } # end SKIP
 311
 312 __END__
 313
 314 =head1 NAME
 315
 316 frobnicate - do what I mean
 317
 318 =head1 SYNOPSIS
 319
 320 B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]>
 321   file ...
 322
 323 =head1 DESCRIPTION
 324
 325 B<frobnicate> does foo and bar and what not.
 326
 327 =head1 OPTIONS
 328
 329 =over 4
 330
 331 =item B<-r> | B<--recursive>
 332
 333 Run recursively.
 334
 335 =item B<-f> | B<--force>
 336
 337 Just do it!
 338
 339 =item B<-n> number
 340
 341 Specify number of frobs, default is 42.
 342
 343 =back
 344
 345 =cut
 346