Commit | Line | Data |
---|---|---|
d44282b9 AT |
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 | { # Test exit status from pod2usage() | |
0cb07b6b | 51 | my $exit = ($^O eq 'VMS' ? 2 : 42); |
d44282b9 AT |
52 | my $dev_null = File::Spec->devnull; |
53 | my $args = join ", ", ( | |
54 | "-verbose => 0", | |
55 | "-exit => $exit", | |
0cb07b6b CB |
56 | "-output => q{$dev_null}", |
57 | "-input => q{$0}", | |
d44282b9 | 58 | ); |
0cb07b6b CB |
59 | my $cq = (($^O eq 'MSWin32' |
60 | || $^O eq 'NetWare' | |
61 | || $^O eq 'VMS') ? '"' | |
62 | : "'"); | |
63 | my @params = ( "${cq}-I../lib$cq", "${cq}-MPod::Usage$cq", '-e' ); | |
64 | my $prg = qq[${cq}pod2usage({ $args })$cq]; | |
65 | my @cmd = ( $^X, @params, $prg ); | |
d44282b9 AT |
66 | |
67 | is( system( @cmd ) >> 8, $exit, 'Exit status of pod2usage()' ); | |
68 | } | |
69 | ||
70 | # Test verbose level 1 | |
71 | my $vbl_1 = << 'EOMSG'; | |
72 | Usage: | |
73 | The SYNOPSIS section is displayed with -verbose >= 0. | |
74 | ||
75 | Options: | |
76 | The OPTIONS section is displayed with -verbose >= 1. | |
77 | ||
78 | Arguments: | |
79 | The ARGUMENTS section is displayed with -verbose >= 1. | |
80 | ||
81 | EOMSG | |
82 | $$fake_out = ''; | |
83 | pod2usage( { -verbose => 1, -exit => 'noexit', -output => \*FAKEOUT } ); | |
84 | is( $$fake_out, $vbl_1, 'Verbose level 1' ); | |
85 | ||
86 | # Test verbose level 2 | |
87 | $$fake_out = ''; | |
88 | require Pod::Text; # Pod::Usage->isa( 'Pod::Text' ) | |
89 | ||
90 | ( my $p2tp = new Pod::Text )->parse_from_file( $0, \*FAKEOUT ); | |
91 | my $pod2text = $$fake_out; | |
92 | ||
93 | $$fake_out = ''; | |
94 | pod2usage( { -verbose => 2, -exit => 'noexit', -output => \*FAKEOUT } ); | |
95 | my $pod2usage = $$fake_out; | |
96 | ||
97 | is( $pod2usage, $pod2text, 'Verbose level >= 2 eq pod2text' ); | |
98 | ||
99 | ||
100 | package CatchOut; | |
101 | sub TIEHANDLE { bless \( my $self ), shift } | |
102 | sub PRINT { my $self = shift; $$self .= $_[0] } | |
103 | ||
104 | __END__ | |
105 | ||
106 | =head1 NAME | |
107 | ||
108 | Usage.t - Tests for Pod::Usage | |
109 | ||
110 | =head1 SYNOPSIS | |
111 | ||
112 | The B<SYNOPSIS> section is displayed with -verbose >= 0. | |
113 | ||
114 | =head1 DESCRIPTION | |
115 | ||
116 | Testing Pod::Usage. This section is not displayed with -verbose < 2. | |
117 | ||
118 | =head1 OPTIONS | |
119 | ||
120 | The B<OPTIONS> section is displayed with -verbose >= 1. | |
121 | ||
122 | =head1 ARGUMENTS | |
123 | ||
124 | The B<ARGUMENTS> section is displayed with -verbose >= 1. | |
125 | ||
126 | =head1 AUTHOR | |
127 | ||
128 | 20020105 Abe Timmerman <abe@ztreet.demon.nl> | |
129 | ||
130 | =cut |