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