"Fossies" - the Fresh Open Source Software Archive

Member "Module-Build-0.4224/t/help.t" (30 May 2017, 5327 Bytes) of package /linux/privat/Module-Build-0.4224.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/perl -w
    2 
    3 use strict;
    4 use lib 't/lib';
    5 use MBTest tests => 23;
    6 
    7 blib_load('Module::Build');
    8 
    9 use DistGen;
   10 
   11 my $dist = DistGen->new;
   12 $dist->regen;
   13 $dist->chdir_in;
   14 
   15 my $restart = sub {
   16   # we're redefining the same package as we go, so...
   17   delete($::{'MyModuleBuilder::'});
   18   delete($INC{'MyModuleBuilder.pm'});
   19   $dist->regen( clean => 1 );
   20 };
   21 
   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 
   54     # guess we can have extra pod later
   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 
  214     # guess we can have extra pod later
  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 );
  246 
  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();
  262 
  263 # vim:ts=2:sw=2:et:sta