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   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
  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