1#!/usr/bin/perl -w 2 3use Test::More; 4use strict; 5 6BEGIN { 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 16sub 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 41sub 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 51SKIP: { 52if('Pod::Usage'->isa('Pod::Text') && $Pod::Text::VERSION < 2.18) { 53 skip("Formatting with Pod::Text $Pod::Text::VERSION not reliable", 33); 54} 55 56my ($exit, $text) = getoutput( sub { pod2usage() } ); 57is ($exit, 2, "Exit status pod2usage ()"); 58ok (compare ($text, <<'EOT'), "Output test pod2usage ()"); 59#Usage: 60# frobnicate [ -r | --recursive ] [ -f | --force ] file ... 61# 62EOT 63 64($exit, $text) = getoutput( sub { pod2usage( 65 -message => 'You naughty person, what did you say?', 66 -verbose => 1 ) }); 67is ($exit, 1, "Exit status pod2usage (-message => '...', -verbose => 1)"); 68ok (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# 83EOT 84 85($exit, $text) = getoutput( sub { pod2usage( 86 -verbose => 2, -exit => 42 ) } ); 87is ($exit, 42, "Exit status pod2usage (-verbose => 2, -exit => 42)"); 88ok (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# 108EOT 109 110($exit, $text) = getoutput( sub { pod2usage(0) } ); 111is ($exit, 0, "Exit status pod2usage (0)"); 112ok (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# 126EOT 127 128($exit, $text) = getoutput( sub { pod2usage(42) } ); 129is ($exit, 42, "Exit status pod2usage (42)"); 130ok (compare ($text, <<'EOT'), "Output test pod2usage (42)"); 131#Usage: 132# frobnicate [ -r | --recursive ] [ -f | --force ] file ... 133# 134EOT 135 136($exit, $text) = getoutput( sub { pod2usage(-verbose => 0, -exit => 'NOEXIT') } ); 137is ($exit, 0, "Exit status pod2usage (-verbose => 0, -exit => 'NOEXIT')"); 138ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 0, -exit => 'NOEXIT')"); 139#Usage: 140# frobnicate [ -r | --recursive ] [ -f | --force ] file ... 141# 142# --NORMAL-RETURN-- 143EOT 144 145($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION') } ); 146is ($exit, 1, "Exit status pod2usage (-verbose => 99, -sections => 'DESCRIPTION')"); 147ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 99, -sections => 'DESCRIPTION')"); 148#Description: 149# frobnicate does foo and bar and what not. 150# 151EOT 152 153# does the __DATA__ work ok as input 154my (@blib, $test_script, $pod_file1, , $pod_file2); 155if (!$ENV{PERL_CORE}) { 156 @blib = '-Mblib'; 157} 158$test_script = File::Spec->catfile(qw(t pod p2u_data.pl)); 159$pod_file1 = File::Spec->catfile(qw(t pod usage.pod)); 160$pod_file2 = File::Spec->catfile(qw(t pod usage2.pod)); 161 162 163($exit, $text) = getoutput( sub { system($^X, @blib, $test_script); exit($? >> 8); } ); 164$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR 165is ($exit, 17, "Exit status pod2usage (-verbose => 2, -input => \*DATA)"); 166ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -input => \*DATA)") or diag "Got:\n$text\n"; 167#NAME 168# Test 169# 170#SYNOPSIS 171# perl podusagetest.pl 172# 173#DESCRIPTION 174# This is a test. 175# 176EOT 177 178# test that SYNOPSIS and USAGE are printed 179($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1, 180 -exitval => 0, -verbose => 0); }); 181$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR 182is ($exit, 0, "Exit status pod2usage with USAGE"); 183ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE") or diag "Got:\n$text\n"; 184#Usage: 185# This is a test for CPAN#33020 186# 187#Usage: 188# And this will be also printed. 189# 190EOT 191 192# test that SYNOPSIS and USAGE are printed with options 193($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1, 194 -exitval => 0, -verbose => 1); }); 195$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR 196is ($exit, 0, "Exit status pod2usage with USAGE and verbose=1"); 197ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=1") or diag "Got:\n$text\n"; 198#Usage: 199# This is a test for CPAN#33020 200# 201#Usage: 202# And this will be also printed. 203# 204#Options: 205# And this with verbose == 1 206# 207EOT 208 209# test that only USAGE is printed when requested 210($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1, 211 -exitval => 0, -verbose => 99, -sections => 'USAGE'); }); 212$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR 213is ($exit, 0, "Exit status pod2usage with USAGE and verbose=99"); 214ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=99") or diag "Got:\n$text\n"; 215#Usage: 216# This is a test for CPAN#33020 217# 218EOT 219 220# test with pod_where 221use_ok('Pod::Find', qw(pod_where)); 222 223($exit, $text) = getoutput( sub { pod2usage( -input => pod_where({-inc => 1}, 'Pod::Usage'), 224 -exitval => 0, -verbose => 0) } ); 225$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR 226is ($exit, 0, "Exit status pod2usage with Pod::Find"); 227ok (compare ($text, <<'EOT'), "Output test pod2usage with Pod::Find") or diag "Got:\n$text\n"; 228#Usage: 229# use Pod::Usage 230# 231# my $message_text = "This text precedes the usage message."; 232# my $exit_status = 2; ## The exit status to use 233# my $verbose_level = 0; ## The verbose level to use 234# my $filehandle = \*STDERR; ## The filehandle to write to 235# 236# pod2usage($message_text); 237# 238# pod2usage($exit_status); 239# 240# pod2usage( { -message => $message_text , 241# -exitval => $exit_status , 242# -verbose => $verbose_level, 243# -output => $filehandle } ); 244# 245# pod2usage( -msg => $message_text , 246# -exitval => $exit_status , 247# -verbose => $verbose_level, 248# -output => $filehandle ); 249# 250# pod2usage( -verbose => 2, 251# -noperldoc => 1 ) 252# 253EOT 254 255# verify that sections are correctly found after nested headings 256($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file2, 257 -exitval => 0, -verbose => 99, 258 -sections => [qw(BugHeader BugHeader/.*')]) }); 259$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR 260is ($exit, 0, "Exit status pod2usage with nested headings"); 261ok (compare ($text, <<'EOT'), "Output test pod2usage with nested headings") or diag "Got:\n$text\n"; 262#BugHeader: 263# Some text 264# 265# BugHeader2: 266# More 267# Still More 268# 269EOT 270 271# Verify that =over =back work OK 272($exit, $text) = getoutput( sub { 273 pod2usage(-input => $pod_file2, 274 -exitval => 0, -verbose => 99, -sections => 'BugHeader/BugHeader2') } ); 275$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR 276is ($exit, 0, "Exit status pod2usage with over/back"); 277ok (compare ($text, <<'EOT'), "Output test pod2usage with over/back") or diag "Got:\n$text\n"; 278# BugHeader2: 279# More 280# Still More 281# 282EOT 283 284# new array API for -sections 285($exit, $text) = getoutput( sub { 286 pod2usage(-input => $pod_file2, 287 -exitval => 0, -verbose => 99, -sections => [qw(Heading-1/!.+ Heading-2/.+)]) } ); 288$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR 289is ($exit, 0, "Exit status pod2usage with -sections => []"); 290ok (compare ($text, <<'EOT'), "Output test pod2usage with -sections => []") or diag "Got:\n$text\n"; 291#Heading-1: 292# One 293# Two 294# 295# Heading-2.2: 296# More text. 297# 298EOT 299 300# allow subheadings in OPTIONS and ARGUMENTS 301($exit, $text) = getoutput( sub { 302 pod2usage(-input => $pod_file2, 303 -exitval => 0, -verbose => 1) } ); 304$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR 305$text =~ s{[*](destination|files)[*]}{$1}g; # strip * chars 306is ($exit, 0, "Exit status pod2usage with subheadings in OPTIONS"); 307ok (compare ($text, <<'EOT'), "Output test pod2usage with subheadings in OPTIONS") or diag "Got:\n$text\n"; 308#Options and Arguments: 309# Arguments: 310# The required arguments (which typically follow any options on the 311# command line) are: 312# 313# destination 314# files 315# 316# Options: 317# Options may be abbreviated. Options which take values may be separated 318# from the values by whitespace or the "=" character. 319# 320EOT 321} # end SKIP 322 323__END__ 324 325=head1 NAME 326 327frobnicate - do what I mean 328 329=head1 SYNOPSIS 330 331B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]> 332 file ... 333 334=head1 DESCRIPTION 335 336B<frobnicate> does foo and bar and what not. 337 338=head1 OPTIONS 339 340=over 4 341 342=item B<-r> | B<--recursive> 343 344Run recursively. 345 346=item B<-f> | B<--force> 347 348Just do it! 349 350=item B<-n> number 351 352Specify number of frobs, default is 42. 353 354=back 355 356=cut 357 358