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