| 1 | #!/usr/bin/perl -w
|
|---|
| 2 |
|
|---|
| 3 | use Test::More;
|
|---|
| 4 |
|
|---|
| 5 | BEGIN {
|
|---|
| 6 | if ($^O eq 'MSWin32' || $^O eq 'VMS') {
|
|---|
| 7 | plan skip_all => "Not portable on Win32 or VMS\n";
|
|---|
| 8 | }
|
|---|
| 9 | else {
|
|---|
| 10 | plan tests => 15;
|
|---|
| 11 | }
|
|---|
| 12 | use_ok ("Pod::Usage");
|
|---|
| 13 | }
|
|---|
| 14 |
|
|---|
| 15 | sub getoutput
|
|---|
| 16 | {
|
|---|
| 17 | my ($code) = @_;
|
|---|
| 18 | my $pid = open(IN, "-|");
|
|---|
| 19 | unless(defined $pid) {
|
|---|
| 20 | die "Cannot fork: $!";
|
|---|
| 21 | }
|
|---|
| 22 | if($pid) {
|
|---|
| 23 | # parent
|
|---|
| 24 | my @out = <IN>;
|
|---|
| 25 | close(IN);
|
|---|
| 26 | my $exit = $?>>8;
|
|---|
| 27 | s/^/#/ for @out;
|
|---|
| 28 | local $" = "";
|
|---|
| 29 | print "#EXIT=$exit OUTPUT=+++#@out#+++\n";
|
|---|
| 30 | return($exit, join("",@out));
|
|---|
| 31 | }
|
|---|
| 32 | # child
|
|---|
| 33 | open(STDERR, ">&STDOUT");
|
|---|
| 34 | &$code;
|
|---|
| 35 | print "--NORMAL-RETURN--\n";
|
|---|
| 36 | exit 0;
|
|---|
| 37 | }
|
|---|
| 38 |
|
|---|
| 39 | sub compare
|
|---|
| 40 | {
|
|---|
| 41 | my ($left,$right) = @_;
|
|---|
| 42 | $left =~ s/^#\s+/#/gm;
|
|---|
| 43 | $right =~ s/^#\s+/#/gm;
|
|---|
| 44 | $left =~ s/\s+/ /gm;
|
|---|
| 45 | $right =~ s/\s+/ /gm;
|
|---|
| 46 | $left eq $right;
|
|---|
| 47 | }
|
|---|
| 48 |
|
|---|
| 49 | my ($exit, $text) = getoutput( sub { pod2usage() } );
|
|---|
| 50 | is ($exit, 2, "Exit status pod2usage ()");
|
|---|
| 51 | ok (compare ($text, <<'EOT'), "Output test pod2usage ()");
|
|---|
| 52 | #Usage:
|
|---|
| 53 | # frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
|
|---|
| 54 | #
|
|---|
| 55 | EOT
|
|---|
| 56 |
|
|---|
| 57 | ($exit, $text) = getoutput( sub { pod2usage(
|
|---|
| 58 | -message => 'You naughty person, what did you say?',
|
|---|
| 59 | -verbose => 1 ) });
|
|---|
| 60 | is ($exit, 1, "Exit status pod2usage (-message => '...', -verbose => 1)");
|
|---|
| 61 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-message => '...', -verbose => 1)");
|
|---|
| 62 | #You naughty person, what did you say?
|
|---|
| 63 | # Usage:
|
|---|
| 64 | # frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
|
|---|
| 65 | #
|
|---|
| 66 | # Options:
|
|---|
| 67 | # -r | --recursive
|
|---|
| 68 | # Run recursively.
|
|---|
| 69 | #
|
|---|
| 70 | # -f | --force
|
|---|
| 71 | # Just do it!
|
|---|
| 72 | #
|
|---|
| 73 | # -n number
|
|---|
| 74 | # Specify number of frobs, default is 42.
|
|---|
| 75 | #
|
|---|
| 76 | EOT
|
|---|
| 77 |
|
|---|
| 78 | ($exit, $text) = getoutput( sub { pod2usage(
|
|---|
| 79 | -verbose => 2, -exit => 42 ) } );
|
|---|
| 80 | is ($exit, 42, "Exit status pod2usage (-verbose => 2, -exit => 42)");
|
|---|
| 81 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -exit => 42)");
|
|---|
| 82 | #NAME
|
|---|
| 83 | # frobnicate - do what I mean
|
|---|
| 84 | #
|
|---|
| 85 | # SYNOPSIS
|
|---|
| 86 | # frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
|
|---|
| 87 | #
|
|---|
| 88 | # DESCRIPTION
|
|---|
| 89 | # frobnicate does foo and bar and what not.
|
|---|
| 90 | #
|
|---|
| 91 | # OPTIONS
|
|---|
| 92 | # -r | --recursive
|
|---|
| 93 | # Run recursively.
|
|---|
| 94 | #
|
|---|
| 95 | # -f | --force
|
|---|
| 96 | # Just do it!
|
|---|
| 97 | #
|
|---|
| 98 | # -n number
|
|---|
| 99 | # Specify number of frobs, default is 42.
|
|---|
| 100 | #
|
|---|
| 101 | EOT
|
|---|
| 102 |
|
|---|
| 103 | ($exit, $text) = getoutput( sub { pod2usage(0) } );
|
|---|
| 104 | is ($exit, 0, "Exit status pod2usage (0)");
|
|---|
| 105 | ok (compare ($text, <<'EOT'), "Output test pod2usage (0)");
|
|---|
| 106 | #Usage:
|
|---|
| 107 | # frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
|
|---|
| 108 | #
|
|---|
| 109 | # Options:
|
|---|
| 110 | # -r | --recursive
|
|---|
| 111 | # Run recursively.
|
|---|
| 112 | #
|
|---|
| 113 | # -f | --force
|
|---|
| 114 | # Just do it!
|
|---|
| 115 | #
|
|---|
| 116 | # -n number
|
|---|
| 117 | # Specify number of frobs, default is 42.
|
|---|
| 118 | #
|
|---|
| 119 | EOT
|
|---|
| 120 |
|
|---|
| 121 | ($exit, $text) = getoutput( sub { pod2usage(42) } );
|
|---|
| 122 | is ($exit, 42, "Exit status pod2usage (42)");
|
|---|
| 123 | ok (compare ($text, <<'EOT'), "Output test pod2usage (42)");
|
|---|
| 124 | #Usage:
|
|---|
| 125 | # frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
|
|---|
| 126 | #
|
|---|
| 127 | EOT
|
|---|
| 128 |
|
|---|
| 129 | ($exit, $text) = getoutput( sub { pod2usage(-verbose => 0, -exit => 'NOEXIT') } );
|
|---|
| 130 | is ($exit, 0, "Exit status pod2usage (-verbose => 0, -exit => 'NOEXIT')");
|
|---|
| 131 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 0, -exit => 'NOEXIT')");
|
|---|
| 132 | #Usage:
|
|---|
| 133 | # frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
|
|---|
| 134 | #
|
|---|
| 135 | # --NORMAL-RETURN--
|
|---|
| 136 | EOT
|
|---|
| 137 |
|
|---|
| 138 | ($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION') } );
|
|---|
| 139 | is ($exit, 1, "Exit status pod2usage (-verbose => 99, -sections => 'DESCRIPTION')");
|
|---|
| 140 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 99, -sections => 'DESCRIPTION')");
|
|---|
| 141 | #Description:
|
|---|
| 142 | # frobnicate does foo and bar and what not.
|
|---|
| 143 | #
|
|---|
| 144 | EOT
|
|---|
| 145 |
|
|---|
| 146 |
|
|---|
| 147 |
|
|---|
| 148 | __END__
|
|---|
| 149 |
|
|---|
| 150 | =head1 NAME
|
|---|
| 151 |
|
|---|
| 152 | frobnicate - do what I mean
|
|---|
| 153 |
|
|---|
| 154 | =head1 SYNOPSIS
|
|---|
| 155 |
|
|---|
| 156 | B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]>
|
|---|
| 157 | S<[ B<-n> I<number> ]> I<file> ...
|
|---|
| 158 |
|
|---|
| 159 | =head1 DESCRIPTION
|
|---|
| 160 |
|
|---|
| 161 | B<frobnicate> does foo and bar and what not.
|
|---|
| 162 |
|
|---|
| 163 | =head1 OPTIONS
|
|---|
| 164 |
|
|---|
| 165 | =over 4
|
|---|
| 166 |
|
|---|
| 167 | =item B<-r> | B<--recursive>
|
|---|
| 168 |
|
|---|
| 169 | Run recursively.
|
|---|
| 170 |
|
|---|
| 171 | =item B<-f> | B<--force>
|
|---|
| 172 |
|
|---|
| 173 | Just do it!
|
|---|
| 174 |
|
|---|
| 175 | =item B<-n> I<number>
|
|---|
| 176 |
|
|---|
| 177 | Specify number of frobs, default is 42.
|
|---|
| 178 |
|
|---|
| 179 | =back
|
|---|
| 180 |
|
|---|
| 181 | =cut
|
|---|
| 182 |
|
|---|