summaryrefslogtreecommitdiff
path: root/t/pod
diff options
context:
space:
mode:
authorSteve Hay <SteveHay@planit.com>2009-01-30 10:27:25 +0000
committerSteve Hay <SteveHay@planit.com>2009-01-30 10:27:25 +0000
commit1bc4b319ba6d50bfdf5332d4378c85af1205184b (patch)
tree7252397d3d1ef704642a76b9b935ddb12fc427dd /t/pod
parentdc3c30404e1546ebc4bd89fa72dfcd44bcd246ee (diff)
downloadperl-1bc4b319ba6d50bfdf5332d4378c85af1205184b.tar.gz
Upgrade to Pod-Parser-1.36.
Three local changes remain in blead: Blank lines "between" verbatim sections are now acceptible: http://perl5.git.perl.org/perl.git/commitdiff/caa547d Be less picky about what constitutes "numeric lists" in Pod: http://perl5.git.perl.org/perl.git/commitdiff/4df4f5d Changes made to contains_pod.t when upgrading to 1.34: http://perl5.git.perl.org/perl.git/commitdiff/fb59f97
Diffstat (limited to 't/pod')
-rw-r--r--t/pod/find.t27
-rw-r--r--t/pod/multiline_items.xr1
-rw-r--r--t/pod/pod2usage.xr4
-rw-r--r--t/pod/pod2usage2.t174
-rw-r--r--t/pod/podchkenc.t29
-rw-r--r--t/pod/podchkenc.xr1
-rw-r--r--t/pod/usage.pod18
-rw-r--r--t/pod/usage2.pod56
8 files changed, 301 insertions, 9 deletions
diff --git a/t/pod/find.t b/t/pod/find.t
index 66b65c5c39..6582dbbdff 100644
--- a/t/pod/find.t
+++ b/t/pod/find.t
@@ -33,12 +33,31 @@ my $VERBOSE = $ENV{PERL_CORE} ? 0 : ($ENV{TEST_VERBOSE} || 0);
my $lib_dir = $ENV{PERL_CORE} ?
File::Spec->catdir('pod', 'testpods', 'lib')
: File::Spec->catdir($THISDIR,'lib');
+
+my $vms_unix_rpt = 0;
+my $vms_efs = 0;
+my $unix_mode = 1;
+
if ($^O eq 'VMS') {
$lib_dir = $ENV{PERL_CORE} ?
VMS::Filespec::unixify(File::Spec->catdir('pod', 'testpods', 'lib'))
: VMS::Filespec::unixify(File::Spec->catdir($THISDIR,'-','lib','pod'));
$Qlib_dir = $lib_dir;
$Qlib_dir =~ s#\/#::#g;
+
+ $unix_mode = 0;
+ if (eval 'require VMS::Feature') {
+ $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
+ $vms_efs = VMS::Feature::current("efs_charset");
+ } else {
+ my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
+ my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
+ $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i;
+ $vms_efs = $efs_charset =~ /^[ET1]/i;
+ }
+
+ # Traditional VMS mode only if VMS is not in UNIX compatible mode.
+ $unix_mode = ($vms_efs && $vms_unix_rpt);
}
print "### searching $lib_dir\n";
@@ -88,7 +107,11 @@ print "### found $result\n";
require Config;
if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms
- $compare = "lib.File]Find.pm";
+ if ($unix_mode) {
+ $compare = "../lib/File/Find.pm";
+ } else {
+ $compare = "lib.File]Find.pm";
+ }
$result =~ s/perl_root:\[\-?\.?//i;
$result =~ s/\[\-?\.?//i; # needed under `mms test`
ok($result,$compare);
@@ -96,7 +119,7 @@ if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms
else {
$compare = $ENV{PERL_CORE} ?
File::Spec->catfile(File::Spec->updir, 'lib','File','Find.pm')
- : File::Spec->catfile($Config::Config{privlib},"File","Find.pm");
+ : File::Spec->catfile($Config::Config{privlibexp},"File","Find.pm");
ok(_canon($result),_canon($compare));
}
diff --git a/t/pod/multiline_items.xr b/t/pod/multiline_items.xr
index dddf05fe34..9eea63a8f0 100644
--- a/t/pod/multiline_items.xr
+++ b/t/pod/multiline_items.xr
@@ -3,3 +3,4 @@ Test multiline item lists
appropriately.
This is a test.
+
diff --git a/t/pod/pod2usage.xr b/t/pod/pod2usage.xr
index 853348fa51..b7c3da563e 100644
--- a/t/pod/pod2usage.xr
+++ b/t/pod/pod2usage.xr
@@ -33,12 +33,12 @@ OPTIONS AND ARGUMENTS
on MSWin32 and DOS).
*file* The pathname of a file containing pod documentation to be output
- in usage mesage format (defaults to standard input).
+ in usage message format (defaults to standard input).
DESCRIPTION
pod2usage will read the given input file looking for pod documentation
and will print the corresponding usage message. If no input file is
- specified than standard input is read.
+ specified then standard input is read.
pod2usage invokes the pod2usage() function in the Pod::Usage module.
Please see the pod2usage() entry in the Pod::Usage manpage.
diff --git a/t/pod/pod2usage2.t b/t/pod/pod2usage2.t
index e5fa93e39d..8f63831471 100644
--- a/t/pod/pod2usage2.t
+++ b/t/pod/pod2usage2.t
@@ -7,7 +7,7 @@ BEGIN {
plan skip_all => "Not portable on Win32 or VMS\n";
}
else {
- plan tests => 15;
+ plan tests => 34;
}
use_ok ("Pod::Usage");
}
@@ -15,14 +15,14 @@ BEGIN {
sub getoutput
{
my ($code) = @_;
- my $pid = open(IN, "-|");
+ my $pid = open(TEST_IN, "-|");
unless(defined $pid) {
die "Cannot fork: $!";
}
if($pid) {
# parent
- my @out = <IN>;
- close(IN);
+ my @out = <TEST_IN>;
+ close(TEST_IN);
my $exit = $?>>8;
s/^/#/ for @out;
local $" = "";
@@ -31,6 +31,7 @@ sub getoutput
}
# child
open(STDERR, ">&STDOUT");
+ Test::More->builder->no_ending(1);
&$code;
print "--NORMAL-RETURN--\n";
exit 0;
@@ -46,6 +47,11 @@ sub compare
$left eq $right;
}
+SKIP: {
+if('Pod::Usage'->isa('Pod::Text') && $Pod::Text::VERSION < 2.18) {
+ skip("Formatting with Pod::Text $Pod::Text::VERSION not reliable", 33);
+}
+
my ($exit, $text) = getoutput( sub { pod2usage() } );
is ($exit, 2, "Exit status pod2usage ()");
ok (compare ($text, <<'EOT'), "Output test pod2usage ()");
@@ -58,7 +64,7 @@ EOT
-message => 'You naughty person, what did you say?',
-verbose => 1 ) });
is ($exit, 1, "Exit status pod2usage (-message => '...', -verbose => 1)");
-ok (compare ($text, <<'EOT'), "Output test pod2usage (-message => '...', -verbose => 1)");
+ok (compare ($text, <<'EOT'), "Output test pod2usage (-message => '...', -verbose => 1)") or diag("Got:\n$text\n");
#You naughty person, what did you say?
# Usage:
# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
@@ -143,7 +149,165 @@ ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 99, -sections
#
EOT
+# does the __DATA__ work ok as input
+($exit, $text) = getoutput( sub { system($^X, '-Mblib', File::Spec->catfile(qw(t pod p2u_data.pl))); exit($? >> 8); } );
+$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
+is ($exit, 17, "Exit status pod2usage (-verbose => 2, -input => \*DATA)");
+ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -input => \*DATA)") or diag "Got:\n$text\n";
+#NAME
+# Test
+#
+#SYNOPSIS
+# perl podusagetest.pl
+#
+#DESCRIPTION
+# This is a test.
+#
+EOT
+
+# test that SYNOPSIS and USAGE are printed
+($exit, $text) = getoutput( sub { pod2usage(-input => File::Spec->catfile(qw(t pod usage.pod)),
+ -exitval => 0, -verbose => 0); });
+$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
+is ($exit, 0, "Exit status pod2usage with USAGE");
+ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE") or diag "Got:\n$text\n";
+#Usage:
+# This is a test for CPAN#33020
+#
+#Usage:
+# And this will be also printed.
+#
+EOT
+# test that SYNOPSIS and USAGE are printed with options
+($exit, $text) = getoutput( sub { pod2usage(-input => File::Spec->catfile(qw(t pod usage.pod)),
+ -exitval => 0, -verbose => 1); });
+$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
+is ($exit, 0, "Exit status pod2usage with USAGE and verbose=1");
+ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=1") or diag "Got:\n$text\n";
+#Usage:
+# This is a test for CPAN#33020
+#
+#Usage:
+# And this will be also printed.
+#
+#Options:
+# And this with verbose == 1
+#
+EOT
+
+# test that only USAGE is printed when requested
+($exit, $text) = getoutput( sub { pod2usage(-input => File::Spec->catfile(qw(t pod usage.pod)),
+ -exitval => 0, -verbose => 99, -sections => 'USAGE'); });
+$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
+is ($exit, 0, "Exit status pod2usage with USAGE and verbose=99");
+ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=99") or diag "Got:\n$text\n";
+#Usage:
+# This is a test for CPAN#33020
+#
+EOT
+
+# test with pod_where
+use_ok('Pod::Find', qw(pod_where));
+($exit, $text) = getoutput( sub { pod2usage( -input => pod_where({-inc => 1}, 'Pod::Usage'),
+ -exitval => 0, -verbose => 0) } );
+$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
+is ($exit, 0, "Exit status pod2usage with Pod::Find");
+ok (compare ($text, <<'EOT'), "Output test pod2usage with Pod::Find") or diag "Got:\n$text\n";
+#Usage:
+# use Pod::Usage
+#
+# my $message_text = "This text precedes the usage message.";
+# my $exit_status = 2; ## The exit status to use
+# my $verbose_level = 0; ## The verbose level to use
+# my $filehandle = \*STDERR; ## The filehandle to write to
+#
+# pod2usage($message_text);
+#
+# pod2usage($exit_status);
+#
+# pod2usage( { -message => $message_text ,
+# -exitval => $exit_status ,
+# -verbose => $verbose_level,
+# -output => $filehandle } );
+#
+# pod2usage( -msg => $message_text ,
+# -exitval => $exit_status ,
+# -verbose => $verbose_level,
+# -output => $filehandle );
+#
+# pod2usage( -verbose => 2,
+# -noperldoc => 1 )
+#
+EOT
+
+# verify that sections are correctly found after nested headings
+($exit, $text) = getoutput( sub { pod2usage(-input => File::Spec->catfile(qw(t pod usage2.pod)),
+ -exitval => 0, -verbose => 99,
+ -sections => [qw(BugHeader BugHeader/.*')]) });
+$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
+is ($exit, 0, "Exit status pod2usage with nested headings");
+ok (compare ($text, <<'EOT'), "Output test pod2usage with nested headings") or diag "Got:\n$text\n";
+#BugHeader:
+# Some text
+#
+# BugHeader2:
+# More
+# Still More
+#
+EOT
+
+# Verify that =over =back work OK
+($exit, $text) = getoutput( sub {
+ pod2usage(-input => File::Spec->catfile(qw(t pod usage2.pod)),
+ -exitval => 0, -verbose => 99, -sections => 'BugHeader/BugHeader2') } );
+$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
+is ($exit, 0, "Exit status pod2usage with over/back");
+ok (compare ($text, <<'EOT'), "Output test pod2usage with over/back") or diag "Got:\n$text\n";
+# BugHeader2:
+# More
+# Still More
+#
+EOT
+
+# new array API for -sections
+($exit, $text) = getoutput( sub {
+ pod2usage(-input => File::Spec->catfile(qw(t pod usage2.pod)),
+ -exitval => 0, -verbose => 99, -sections => [qw(Heading-1/!.+ Heading-2/.+)]) } );
+$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
+is ($exit, 0, "Exit status pod2usage with -sections => []");
+ok (compare ($text, <<'EOT'), "Output test pod2usage with -sections => []") or diag "Got:\n$text\n";
+#Heading-1:
+# One
+# Two
+#
+# Heading-2.2:
+# More text.
+#
+EOT
+
+# allow subheadings in OPTIONS and ARGUMENTS
+($exit, $text) = getoutput( sub {
+ pod2usage(-input => File::Spec->catfile(qw(t pod usage2.pod)),
+ -exitval => 0, -verbose => 1) } );
+$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
+$text =~ s{[*](destination|files)[*]}{$1}g; # strip * chars
+is ($exit, 0, "Exit status pod2usage with subheadings in OPTIONS");
+ok (compare ($text, <<'EOT'), "Output test pod2usage with subheadings in OPTIONS") or diag "Got:\n$text\n";
+#Options and Arguments:
+# Arguments:
+# The required arguments (which typically follow any options on the
+# command line) are:
+#
+# destination
+# files
+#
+# Options:
+# Options may be abbreviated. Options which take values may be separated
+# from the values by whitespace or the "=" character.
+#
+EOT
+} # end SKIP
__END__
diff --git a/t/pod/podchkenc.t b/t/pod/podchkenc.t
new file mode 100644
index 0000000000..ccc2421a5a
--- /dev/null
+++ b/t/pod/podchkenc.t
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+BEGIN {
+ use File::Basename;
+ my $THISDIR = dirname $0;
+ unshift @INC, $THISDIR;
+ require "testpchk.pl";
+ import TestPodChecker;
+}
+
+# this tests Pod::Checker accepts =encoding directive
+
+my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash
+my $passed = testpodchecker \%options, $0;
+exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE};
+
+__END__
+
+=encoding utf8
+
+=encode utf8
+
+dummy error
+
+=head1 An example.
+
+'Twas brillig, and the slithy toves did gyre and gimble in the wabe.
+
+=cut
+
diff --git a/t/pod/podchkenc.xr b/t/pod/podchkenc.xr
new file mode 100644
index 0000000000..45ec573fa2
--- /dev/null
+++ b/t/pod/podchkenc.xr
@@ -0,0 +1 @@
+*** ERROR: Unknown command 'encode' at line 20 in file t/pod/podchkenc.t
diff --git a/t/pod/usage.pod b/t/pod/usage.pod
new file mode 100644
index 0000000000..c81cc82c51
--- /dev/null
+++ b/t/pod/usage.pod
@@ -0,0 +1,18 @@
+=head1 NAME
+
+usage.pod - example for testing USAGE and SYNOPSIS
+
+=head1 USAGE
+
+This is a test for CPAN#33020
+
+=head1 SYNOPSIS
+
+And this will be also printed.
+
+=head1 OPTIONS
+
+And this with verbose == 1
+
+=cut
+
diff --git a/t/pod/usage2.pod b/t/pod/usage2.pod
new file mode 100644
index 0000000000..1e03b7dfc6
--- /dev/null
+++ b/t/pod/usage2.pod
@@ -0,0 +1,56 @@
+=head1 Heading-1
+
+=over 100
+
+=item One
+
+=item Two
+
+=back
+
+=head2 Heading 2
+
+Some text
+
+=head1 BugHeader
+
+Some text
+
+=head2 BugHeader2
+
+=over 4
+
+=item More
+
+=item Still More
+
+=back
+
+=head1 Heading-2
+
+=head2 Heading-2.2
+
+More text.
+
+=head1 OPTIONS AND ARGUMENTS
+
+=head2 Arguments
+
+The required arguments (which typically follow any options on the
+command line) are:
+
+=over
+
+=item I<destination>
+
+=item I<files>
+
+=back
+
+=head2 Options
+
+Options may be abbreviated. Options which take values may be separated
+from the values by whitespace or the "=" character.
+
+=cut
+