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