Commit | Line | Data |
c1d8f74e |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
4 | use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib'; |
738349a8 |
5 | use MBTest tests => 25; |
6 | |
7 | use_ok 'Module::Build'; |
8 | ensure_blib('Module::Build'); |
c1d8f74e |
9 | |
10 | use Cwd (); |
11 | use File::Path (); |
12 | |
13 | my $cwd = Cwd::cwd(); |
7a827510 |
14 | my $tmp = MBTest->tmpdir; |
c1d8f74e |
15 | |
16 | use DistGen; |
17 | |
18 | my $dist = DistGen->new(dir => $tmp); |
19 | |
20 | |
21 | $dist->regen; |
22 | |
23 | my $restart = sub { |
24 | $dist->clean(); |
25 | chdir( $cwd ); |
26 | File::Path::rmtree( $tmp ); |
27 | # we're redefining the same package as we go, so... |
28 | delete($::{'MyModuleBuilder::'}); |
29 | delete($INC{'MyModuleBuilder.pm'}); |
30 | $dist->regen; |
31 | chdir($dist->dirname) or |
32 | die "Can't chdir to '@{[$dist->dirname]}': $!"; |
33 | }; |
34 | |
35 | chdir($dist->dirname) or die "Can't chdir to '@{[$dist->dirname]}': $!"; |
36 | |
c1d8f74e |
37 | ######################################################################## |
38 | { # check the =item style |
39 | my $mb = Module::Build->subclass( |
40 | code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---', |
41 | =head1 ACTIONS |
42 | |
43 | =over |
44 | |
45 | =item foo |
46 | |
47 | Does the foo thing. |
48 | |
49 | =item bar |
50 | |
51 | Does the bar thing. |
52 | |
53 | =item help |
54 | |
55 | Does the help thing. |
56 | |
57 | You should probably not be seeing this. That is, we haven't |
58 | overridden the help action, but we're able to override just the |
59 | docs? That almost seems reasonable, but is probably wrong. |
60 | |
61 | =back |
62 | |
63 | =cut |
64 | |
65 | sub ACTION_foo { die "fooey" } |
66 | sub ACTION_bar { die "barey" } |
67 | sub ACTION_baz { die "bazey" } |
68 | |
69 | # guess we can have extra pod later |
70 | |
71 | =over |
72 | |
73 | =item baz |
74 | |
75 | Does the baz thing. |
76 | |
77 | =back |
78 | |
79 | =cut |
80 | |
81 | --- |
82 | )->new( |
83 | module_name => $dist->name, |
84 | ); |
85 | |
86 | ok $mb; |
87 | can_ok($mb, 'ACTION_foo'); |
88 | |
89 | foreach my $action (qw(foo bar baz)) { # typical usage |
90 | my $doc = $mb->get_action_docs($action); |
91 | ok($doc, "got doc for '$action'"); |
92 | like($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s, |
93 | 'got the right doc'); |
94 | } |
95 | |
96 | { # user typo'd the action name |
97 | ok( ! eval {$mb->get_action_docs('batz'); 1}, 'slap'); |
98 | like($@, qr/No known action 'batz'/, 'informative error'); |
99 | } |
100 | |
101 | { # XXX this one needs some thought |
102 | my $action = 'help'; |
103 | my $doc = $mb->get_action_docs($action); |
104 | ok($doc, "got doc for '$action'"); |
105 | 0 and warn "help doc >\n$doc<\n"; |
106 | TODO: { |
107 | local $TODO = 'Do we allow overrides on just docs?'; |
108 | unlike($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s, |
109 | 'got the right doc'); |
110 | } |
111 | } |
112 | } # end =item style |
113 | $restart->(); |
114 | ######################################################################## |
115 | if(0) { # the =item style without spanning =head1 sections |
116 | my $mb = Module::Build->subclass( |
117 | code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---', |
118 | =head1 ACTIONS |
119 | |
120 | =over |
121 | |
122 | =item foo |
123 | |
124 | Does the foo thing. |
125 | |
126 | =item bar |
127 | |
128 | Does the bar thing. |
129 | |
130 | =back |
131 | |
132 | =head1 thbbt |
133 | |
134 | =over |
135 | |
136 | =item baz |
137 | |
138 | Should not see this. |
139 | |
140 | =back |
141 | |
142 | =cut |
143 | |
144 | sub ACTION_foo { die "fooey" } |
145 | sub ACTION_bar { die "barey" } |
146 | sub ACTION_baz { die "bazey" } |
147 | |
148 | --- |
149 | )->new( |
150 | module_name => $dist->name, |
151 | ); |
152 | |
153 | ok $mb; |
154 | can_ok($mb, 'ACTION_foo'); |
155 | |
156 | foreach my $action (qw(foo bar)) { # typical usage |
157 | my $doc = $mb->get_action_docs($action); |
158 | ok($doc, "got doc for '$action'"); |
159 | like($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s, |
160 | 'got the right doc'); |
161 | } |
162 | is($mb->get_action_docs('baz'), undef, 'no jumping =head1 sections'); |
163 | |
164 | } # end =item style without spanning =head1's |
165 | $restart->(); |
166 | ######################################################################## |
167 | TODO: { # the =item style with 'Actions' not 'ACTIONS' |
168 | local $TODO = 'Support capitalized Actions section'; |
169 | my $mb = Module::Build->subclass( |
170 | code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---', |
171 | =head1 Actions |
172 | |
173 | =over |
174 | |
175 | =item foo |
176 | |
177 | Does the foo thing. |
178 | |
179 | =item bar |
180 | |
181 | Does the bar thing. |
182 | |
183 | =back |
184 | |
185 | =cut |
186 | |
187 | sub ACTION_foo { die "fooey" } |
188 | sub ACTION_bar { die "barey" } |
189 | |
190 | --- |
191 | )->new( |
192 | module_name => $dist->name, |
193 | ); |
194 | |
195 | foreach my $action (qw(foo bar)) { # typical usage |
196 | my $doc = $mb->get_action_docs($action); |
197 | ok($doc, "got doc for '$action'"); |
198 | like($doc || 'undef', qr/^=\w+ $action\n\nDoes the $action thing\./s, |
199 | 'got the right doc'); |
200 | } |
201 | |
202 | } # end =item style with Actions |
203 | $restart->(); |
204 | ######################################################################## |
205 | { # check the =head2 style |
206 | my $mb = Module::Build->subclass( |
207 | code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---', |
208 | =head1 ACTIONS |
209 | |
210 | =head2 foo |
211 | |
212 | Does the foo thing. |
213 | |
214 | =head2 bar |
215 | |
216 | Does the bar thing. |
217 | |
218 | =head3 bears |
219 | |
220 | Be careful with bears. |
221 | |
222 | =cut |
223 | |
224 | sub ACTION_foo { die "fooey" } |
225 | sub ACTION_bar { die "barey" } |
226 | sub ACTION_baz { die "bazey" } |
227 | sub ACTION_batz { die "batzey" } |
228 | |
229 | # guess we can have extra pod later |
230 | # Though, I do wonder whether we should allow them to mix... |
231 | # maybe everything should have to be head2? |
232 | |
233 | =head2 baz |
234 | |
235 | Does the baz thing. |
236 | |
237 | =head4 What's a baz? |
238 | |
239 | =head1 not this part |
240 | |
241 | This is level 1, so the stuff about baz is done. |
242 | |
243 | =head1 Thing |
244 | |
245 | =head2 batz |
246 | |
247 | This is not an action doc. |
248 | |
249 | =cut |
250 | |
251 | --- |
252 | )->new( |
253 | module_name => $dist->name, |
254 | ); |
255 | |
256 | my %also = ( |
257 | foo => '', |
258 | bar => "\n=head3 bears\n\nBe careful with bears.\n", |
259 | baz => "\n=head4 What's a baz\\?\n", |
260 | ); |
261 | |
262 | foreach my $action (qw(foo bar baz)) { |
263 | my $doc = $mb->get_action_docs($action); |
264 | ok($doc, "got doc for '$action'"); |
265 | my $and = $also{$action}; |
266 | like($doc || 'undef', |
267 | qr/^=\w+ $action\n\nDoes the $action thing\.\n$and\n$/s, |
268 | 'got the right doc'); |
269 | } |
270 | is($mb->get_action_docs('batz'), undef, 'nothing after uplevel'); |
271 | |
272 | } # end =head2 style |
273 | ######################################################################## |
274 | |
275 | # cleanup |
276 | $dist->clean(); |
277 | chdir( $cwd ); |
278 | File::Path::rmtree( $tmp ); |
279 | |
280 | # vim:ts=2:sw=2:et:sta |