t/pod/pod2usage2.t

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