Update Module::Build to 0.35
[perl.git] / lib / Module / Build / t / help.t
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 tests => 25;
6
7 use_ok 'Module::Build';
8 ensure_blib('Module::Build');
9
10 use Cwd ();
11 use File::Path ();
12
13 my $cwd = Cwd::cwd();
14 my $tmp = MBTest->tmpdir;
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   DistGen::chdir_all( $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
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 DistGen::chdir_all($cwd);
278 File::Path::rmtree( $tmp );
279
280 # vim:ts=2:sw=2:et:sta