]>
Commit | Line | Data |
---|---|---|
1 | #!/usr/bin/perl -w | |
2 | ||
3 | use strict; | |
4 | use Test::More tests => 20; | |
5 | use Data::Dumper; | |
6 | ||
7 | use vars qw($section_1 $section_2 $section_3 $section_4 %options); | |
8 | ||
9 | use_ok( | |
10 | "Pod::Constants", | |
11 | section_1 => \$section_1, | |
12 | -trim => 1, | |
13 | section_2 => \$section_2, | |
14 | section_3 => sub { tr/[a-z]/[A-Z]/; $section_3 = $_ }, | |
15 | section_4 => sub { eval }, | |
16 | 'command line parameters' => sub { | |
17 | &Pod::Constants::add_hook | |
18 | ( | |
19 | #-trim => 0, | |
20 | '*item' => sub { | |
21 | my ($options, $description) = | |
22 | m/^(.*?)\n\n(.*)/s; | |
23 | my (@options, $longest); | |
24 | $longest = ""; | |
25 | for my $option | |
26 | ($options =~ m/\G((?:-\w|--\w+))(?:,\s*)?/g) { | |
27 | push @options, $option; | |
28 | if ( length $option > length $longest) { | |
29 | $longest = $option; | |
30 | } | |
31 | } | |
32 | $longest =~ s/^-*//; | |
33 | $options{$longest} = | |
34 | { | |
35 | options => \@options, | |
36 | description => $description, | |
37 | }; | |
38 | } | |
39 | ) | |
40 | }, | |
41 | ); | |
42 | ||
43 | # try as hard as we can to get the path to perl | |
44 | ok($Pod::Constants::VERSION, | |
45 | "Pod::Constants sets its own VERSION"); | |
46 | ||
47 | BEGIN { | |
48 | push @INC, "t"; | |
49 | }; | |
50 | # to avoid a warning | |
51 | if ( 0 ) { $Cheese::foo = $ReEntrancyTest::wohoo = $Cheese::quux; } | |
52 | eval "use Cheese"; | |
53 | ||
54 | is($section_1, "Down with Pants!\n\n", "no trim from main"); | |
55 | is($section_2, "42", "with trim from main"); | |
56 | is($section_3, "CLANK_EST", "sub"); | |
57 | is($section_4, "touche", "eval"); | |
58 | is($Cheese::foo, "detcepxe", "From module"); | |
59 | is($ReEntrancyTest::wohoo, "Re-entrancy works!", "From module"); | |
60 | is($Cheese::quux, "Blah.", "From module(2)"); | |
61 | like(`$^X -c t/Cheese.pm 2>&1`, qr/syntax OK/, "perl -c module"); | |
62 | like(`$^X -c t/cheese.pl 2>&1`, qr/syntax OK/, "perl -c script"); | |
63 | ||
64 | # test the examples on the man page :) | |
65 | package Pod::Constants; | |
66 | Pod::Constants->import (SYNOPSIS => sub { | |
67 | $main::section_1 = join "\n", map { s/^ //; $_ } split /\n/, $_ | |
68 | }); | |
69 | ||
70 | package main; | |
71 | open NEWPKG, ">t/TestManPage.pm" or die $!; | |
72 | # why define your test results when you can read them in from POD? | |
73 | $section_1 =~ s/myhash\)/myhash %myhash2)/; | |
74 | $section_1 =~ s/myhash;/myhash, "%myhash\'s value after the above:" => sub { %myhash2 = eval };/; | |
75 | print NEWPKG "package TestManPage;\n$section_1\n2.818;\n"; | |
76 | close NEWPKG; | |
77 | ||
78 | use_ok("TestManPage"); | |
79 | ||
80 | is($TestManPage::myvar, 'This string will be loaded into $myvar', | |
81 | "man page example 1"); | |
82 | is($TestManPage::VERSION, $Pod::Constants::VERSION, | |
83 | "man page example 2"); | |
84 | ok($TestManPage::VERSION, | |
85 | "man page example 2 cross-check"); | |
86 | is($TestManPage::myarray[2], 'For example, this is $myarray[2].', | |
87 | "man page example 3"); | |
88 | my $ok = 0; | |
89 | while (my ($k, $v) = each %TestManPage::myhash) { | |
90 | if (exists $TestManPage::myhash2{$k}) { $ok ++ }; | |
91 | if ($v eq $TestManPage::myhash2{$k}) { $ok ++ }; | |
92 | } | |
93 | is($ok, 4, | |
94 | "man page example 4"); | |
95 | is(scalar keys %TestManPage::myhash, 2, | |
96 | "man page example 4 cross-check"); | |
97 | is($TestManPage::html, '<p>This text will be in $html</p>', | |
98 | "man page example 5"); | |
99 | # supress warnings | |
100 | $TestManPage::myvar = $TestManPage::html = undef; | |
101 | @TestManPage::myarray = (); | |
102 | ||
103 | is($options{foo}->{options}->[0], "-f", "Pod::Constants::add_hook"); | |
104 | ||
105 | =head2 section_1 | |
106 | ||
107 | Down with Pants! | |
108 | ||
109 | =head2 section_2 | |
110 | ||
111 | 42 | |
112 | ||
113 | =head2 section_3 | |
114 | ||
115 | clank_est | |
116 | ||
117 | =head2 section_4 | |
118 | ||
119 | $section_4 = "touche" | |
120 | ||
121 | =cut | |
122 | ||
123 | =head1 command line parameters | |
124 | ||
125 | the following command line parameters are supported | |
126 | ||
127 | =item -f, --foo | |
128 | ||
129 | This does something cool. | |
130 | ||
131 | =item -h, --help | |
132 | ||
133 | This also does something pretty cool. | |
134 | ||
135 | =cut |