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