This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Pod::Html - correctly link to =item's on the same page
[perl5.git] / lib / Pod / t / Usage.t
1 #!perl
2 use strict;
3 BEGIN {
4         chdir 't' if -d 't';
5         @INC = '../lib';
6 }
7
8 use File::Basename;
9 use File::Spec;
10 use Test::More;
11 plan tests => 8;
12
13 use_ok( 'Pod::Usage' );
14
15 # Test verbose level 0
16 my $vbl_0 = << 'EOMSG';
17 Usage:
18     The SYNOPSIS section is displayed with -verbose >= 0.
19
20 EOMSG
21 my $fake_out = tie *FAKEOUT, 'CatchOut';
22 pod2usage({ -verbose => 0, -exit => 'noexit', -output => \*FAKEOUT });
23 is( $$fake_out, $vbl_0, 'Verbose level 0' );
24
25 my $msg = "Prefix message for pod2usage()";
26 $$fake_out = '';
27 pod2usage({ -verbose => 0, -exit => 'noexit', -output => \*FAKEOUT,
28             -message => $msg });
29 is( $$fake_out, "$msg\n$vbl_0", '-message parameter' );
30
31 SKIP: {
32     my( $file, $path ) = fileparse( $0 );
33     skip( 'File in current directory', 2 ) if -e $file; 
34     $$fake_out = '';
35     eval {
36         pod2usage({ -verbose => 0, -exit => 'noexit', 
37                     -output => \*FAKEOUT, -input => $file });
38     };
39     like( $@, qr/^Can't open $file for reading:/, 
40           'File not found without -pathlist' );
41
42     eval {
43         pod2usage({ -verbose => 0, -exit => 'noexit',
44                     -output => \*FAKEOUT, -input => $file, 
45                     -pathlist => $path });
46     };
47     is( $$fake_out, $vbl_0, '-pathlist parameter' );
48 }
49
50 SKIP: { # Test exit status from pod2usage()
51     skip "Exit status broken on Mac OS", 1 if $^O eq 'MacOS';
52     my $exit = ($^O eq 'VMS' ? 2 : 42);
53     my $dev_null = File::Spec->devnull;
54     my $args = join ", ", (
55         "-verbose => 0", 
56         "-exit    => $exit",
57         "-output  => q{$dev_null}",
58         "-input   => q{$0}",
59     );
60     my $cq = (($^O eq 'MSWin32'
61                || $^O eq 'NetWare'
62                || $^O eq 'VMS') ? '"'
63               : "");
64     my @params = ( "${cq}-I../lib$cq",  "${cq}-MPod::Usage$cq", '-e' );
65     my $prg = qq[${cq}pod2usage({ $args })$cq];
66     my @cmd = ( $^X, @params, $prg );
67
68     print "# cmd = @cmd\n";
69
70     is( system( @cmd ) >> 8, $exit, 'Exit status of pod2usage()' );
71 }
72
73 # Test verbose level 1
74 my $vbl_1 = << 'EOMSG';
75 Usage:
76     The SYNOPSIS section is displayed with -verbose >= 0.
77
78 Options:
79     The OPTIONS section is displayed with -verbose >= 1.
80
81 Arguments:
82     The ARGUMENTS section is displayed with -verbose >= 1.
83
84 EOMSG
85 $$fake_out = '';
86 pod2usage( { -verbose => 1, -exit => 'noexit', -output => \*FAKEOUT } );
87 is( $$fake_out, $vbl_1, 'Verbose level 1' );
88
89 # Test verbose level 2
90 $$fake_out = '';
91 require Pod::Text; # Pod::Usage->isa( 'Pod::Text' )
92
93 ( my $p2tp = new Pod::Text )->parse_from_file( $0, \*FAKEOUT );
94 my $pod2text = $$fake_out;
95
96 $$fake_out = '';
97 pod2usage( { -verbose => 2, -exit => 'noexit', -output => \*FAKEOUT } );
98 my $pod2usage = $$fake_out;
99
100 is( $pod2usage, $pod2text, 'Verbose level >= 2 eq pod2text' );
101
102
103 package CatchOut;
104 sub TIEHANDLE { bless \( my $self ), shift }
105 sub PRINT     { my $self = shift; $$self .= $_[0] }
106
107 __END__
108
109 =head1 NAME
110
111 Usage.t - Tests for Pod::Usage
112
113 =head1 SYNOPSIS
114
115 The B<SYNOPSIS> section is displayed with -verbose >= 0.
116
117 =head1 DESCRIPTION
118
119 Testing Pod::Usage. This section is not displayed with -verbose < 2.
120
121 =head1 OPTIONS
122
123 The B<OPTIONS> section is displayed with -verbose >= 1.
124
125 =head1 ARGUMENTS
126
127 The B<ARGUMENTS> section is displayed with -verbose >= 1.
128
129 =head1 AUTHOR
130
131 20020105 Abe Timmerman <abe@ztreet.demon.nl>
132
133 =cut