Upgrade to Pod::Parser 1.33

p4raw-id: //depot/perl@25543

3 files changed, 188 insertions, 23 deletions

diff --git a/t/pod/find.t b/t/pod/find.t
index 20586014f1..66b65c5c39 100644
--- a/t/pod/find.t
+++ b/t/pod/find.t
@@ -88,7 +88,6 @@ print "### found $result\n";
 
 require Config;
 if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms
-    $result = VMS::Filespec::vmsify($result); #if you want VMS you need to force it.
     $compare = "lib.File]Find.pm";
     $result =~ s/perl_root:\[\-?\.?//i;
     $result =~ s/\[\-?\.?//i; # needed under `mms test`
@@ -102,31 +101,19 @@ else {
 }
 
 # Search for a documentation pod rather than a module
-my $searchpod = $ENV{PERL_CORE} ? 'Stuff' : 'perlfunc';
+my $searchpod = 'Stuff';
 print "### searching for $searchpod.pod\n";
-$result = pod_where($ENV{PERL_CORE} ?
-  { -dirs => [ File::Spec->catdir('pod', 'testpods', 'lib', 'Pod') ],
-    -verbose => $VERBOSE }
-  : { -inc => 1, -verbose => $VERBOSE }, $searchpod)
+$result = pod_where(
+  { -dirs => [ File::Spec->catdir(
+    $ENV{PERL_CORE} ? () : qw(t), 'pod', 'testpods', 'lib', 'Pod') ],
+    -verbose => $VERBOSE }, $searchpod)
   || "undef - $searchpod.pod not found!";
 print "### found $result\n";
 
-if($ENV{PERL_CORE}) {
-    $compare = File::Spec->catfile('pod', 'testpods', 'lib', 'Pod' ,'Stuff.pm');
-    ok(_canon($result),_canon($compare));
-}
-elsif ($^O eq 'VMS') { # privlib is perl_root:[lib] unfortunately
-    $compare = "/lib/pod/perlfunc.pod";
-    $result = VMS::Filespec::unixify($result);
-    $result =~ s/perl_root\///i;
-    $result =~ s/^\.\.//;  # needed under `mms test`
-    ok($result,$compare);
-}
-else {
-    $compare = File::Spec->catfile($Config::Config{privlib},
-      ($^O =~ /macos|darwin|cygwin/i ? 'pods' : 'pod'),"perlfunc.pod");
-    ok(_canon($result),_canon($compare));
-}
+$compare = File::Spec->catfile(
+    $ENV{PERL_CORE} ? () : qw(t),
+    'pod', 'testpods', 'lib', 'Pod' ,'Stuff.pm');
+ok(_canon($result),_canon($compare));
 
 # make the path as generic as possible
 sub _canon
diff --git a/t/pod/pod2usage2.t b/t/pod/pod2usage2.t
new file mode 100644
index 0000000000..04890f207f
--- /dev/null
+++ b/t/pod/pod2usage2.t
@@ -0,0 +1,178 @@
+#!/usr/bin/perl -w
+
+use Test;
+
+BEGIN {
+  plan tests => 8;
+}
+
+eval "use Pod::Usage";
+
+ok($@ eq '');
+
+sub getoutput
+{
+  my ($code) = @_;
+  my $pid = open(IN, "-|");
+  unless(defined $pid) {
+    die "Cannot fork: $!";
+  }
+  if($pid) {
+    # parent
+    my @out = <IN>;
+    close(IN);
+    my $exit = $?>>8;
+    print "\nEXIT=$exit OUTPUT=+++\n@out+++\n";
+    return($exit, join("",@out));
+  }
+  # child
+  open(STDERR, ">&STDOUT");
+  &$code;
+  print "--NORMAL-RETURN--\n";
+  exit 0;
+}
+
+sub compare
+{
+  my ($left,$right) = @_;
+  $left =~ s/[
\n]+/\n/sg;
+  $right =~ s/[
\n]+/\n/sg;
+  $left =~ s/\s+/ /gm;
+  $right =~ s/\s+/ /gm;
+  $left eq $right;
+}
+
+# test 2
+my ($exit, $text) = getoutput( sub { pod2usage() } );
+ok($exit == 2 && compare($text, <<'EOT'));
+Usage:
+    frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+
+EOT
+
+# test 3
+($exit, $text) = getoutput( sub { pod2usage(
+  -message => 'You naughty person, what did you say?',
+  -verbose => 1 ) } );
+ok($exit == 1 && compare($text,<<'EOT'));
+You naughty person, what did you say?
+ Usage:
+     frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+ 
+ Options:
+     -r | --recursive
+         Run recursively.
+ 
+     -f | --force
+         Just do it!
+ 
+     -n number
+         Specify number of frobs, default is 42.
+ 
+EOT
+
+# test 4
+($exit, $text) = getoutput( sub { pod2usage(
+  -verbose => 2, -exit => 42 ) } );
+ok($exit == 42 && compare($text,<<'EOT'));
+NAME
+     frobnicate - do what I mean
+
+ SYNOPSIS
+     frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+
+ DESCRIPTION
+     frobnicate does foo and bar and what not.
+
+ OPTIONS
+     -r | --recursive
+         Run recursively.
+
+     -f | --force
+         Just do it!
+
+     -n number
+         Specify number of frobs, default is 42.
+
+EOT
+
+# test 5
+($exit, $text) = getoutput( sub { pod2usage(0) } );
+ok($exit == 0 && compare($text, <<'EOT'));
+Usage:
+     frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+
+ Options:
+     -r | --recursive
+         Run recursively.
+
+     -f | --force
+         Just do it!
+
+     -n number
+         Specify number of frobs, default is 42.
+
+EOT
+
+# test 6
+($exit, $text) = getoutput( sub { pod2usage(42) } );
+ok($exit == 42 && compare($text, <<'EOT'));
+Usage:
+     frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+
+EOT
+
+# test 7
+($exit, $text) = getoutput( sub { pod2usage(-verbose => 0, -exit => 'NOEXIT') } );
+ok($exit == 0 && compare($text, <<'EOT'));
+Usage:
+     frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+
+ --NORMAL-RETURN--
+EOT
+
+# test 8
+($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION') } );
+ok($exit == 1 && compare($text, <<'EOT'));
+Description:
+     frobnicate does foo and bar and what not.
+
+EOT
+
+
+
+__END__
+
+=head1 NAME
+
+frobnicate - do what I mean
+
+=head1 SYNOPSIS
+
+B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]>
+  S<[ B<-n> I<number> ]> I<file> ...
+
+=head1 DESCRIPTION
+
+B<frobnicate> does foo and bar and what not.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-r> | B<--recursive>
+
+Run recursively.
+
+=item B<-f> | B<--force>
+
+Just do it!
+
+=item B<-n> I<number>
+
+Specify number of frobs, default is 42.
+
+=back
+
+=cut
+
diff --git a/t/pod/poderrs.xr b/t/pod/poderrs.xr
index a8ef58bfb5..5b40d7a138 100644
--- a/t/pod/poderrs.xr
+++ b/t/pod/poderrs.xr
@@ -17,7 +17,7 @@
 *** ERROR: =end without =begin at line 77 in file t/pod/poderrs.t
 *** ERROR: No argument for =begin at line 83 in file t/pod/poderrs.t
 *** ERROR: =for without formatter specification at line 89 in file t/pod/poderrs.t
-*** ERROR: nested commands C<...C<...>...> at line 95 in file t/pod/poderrs.t
+*** WARNING: nested commands C<...C<...>...> at line 95 in file t/pod/poderrs.t
 *** ERROR: garbled entity E<alea iacta est> at line 99 in file t/pod/poderrs.t
 *** ERROR: garbled entity E<C<auml>> at line 100 in file t/pod/poderrs.t
 *** ERROR: garbled entity E<abcI<bla>> at line 101 in file t/pod/poderrs.t