X-Git-Url: http://vcs.maemo.org/git/?a=blobdiff_plain;f=dev%2Fi386%2Flibmodule-build-perl%2Flibmodule-build-perl-0.2808.01%2Ft%2Fhelp.t;fp=dev%2Fi386%2Flibmodule-build-perl%2Flibmodule-build-perl-0.2808.01%2Ft%2Fhelp.t;h=ef43e126ec7c6d9de0fdf2bd8e0890ee13b30098;hb=8977e561d8a9eae6959218b0306c9df2056a38a9;hp=0000000000000000000000000000000000000000;hpb=df794b845212301ea0d267c919232538bfef356a;p=dh-make-perl

diff --git a/dev/i386/libmodule-build-perl/libmodule-build-perl-0.2808.01/t/help.t b/dev/i386/libmodule-build-perl/libmodule-build-perl-0.2808.01/t/help.t
new file mode 100644
index 0000000..ef43e12
--- /dev/null
+++ b/dev/i386/libmodule-build-perl/libmodule-build-perl-0.2808.01/t/help.t
@@ -0,0 +1,279 @@
+#!/usr/bin/perl -w
+
+use strict;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+use MBTest 'no_plan';#tests => 0;
+
+use Cwd ();
+use File::Path ();
+
+my $cwd = Cwd::cwd();
+my $tmp = MBTest->tmpdir;
+
+use DistGen;
+
+my $dist = DistGen->new(dir => $tmp);
+
+
+$dist->regen;
+
+my $restart = sub {
+  $dist->clean();
+  chdir( $cwd );
+  File::Path::rmtree( $tmp );
+  # we're redefining the same package as we go, so...
+  delete($::{'MyModuleBuilder::'});
+  delete($INC{'MyModuleBuilder.pm'});
+  $dist->regen;
+  chdir($dist->dirname) or
+    die "Can't chdir to '@{[$dist->dirname]}': $!";
+};
+
+chdir($dist->dirname) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+
+use_ok 'Module::Build';
+
+########################################################################
+{ # check the =item style
+my $mb = Module::Build->subclass(
+  code => join "\n", map {s/^ {4}//; $_} split /\n/, <<'  ---',
+    =head1 ACTIONS
+
+    =over
+
+    =item foo
+
+    Does the foo thing.
+
+    =item bar
+
+    Does the bar thing.
+
+    =item help
+
+    Does the help thing.
+
+    You should probably not be seeing this.  That is, we haven't
+    overridden the help action, but we're able to override just the
+    docs?  That almost seems reasonable, but is probably wrong.
+
+    =back
+
+    =cut
+
+    sub ACTION_foo { die "fooey" }
+    sub ACTION_bar { die "barey" }
+    sub ACTION_baz { die "bazey" }
+
+    # guess we can have extra pod later 
+
+    =over
+
+    =item baz
+
+    Does the baz thing.
+
+    =back
+
+    =cut
+
+  ---
+  )->new(
+      module_name => $dist->name,
+  );
+
+ok $mb;
+can_ok($mb, 'ACTION_foo');
+
+foreach my $action (qw(foo bar baz)) { # typical usage
+  my $doc = $mb->get_action_docs($action);
+  ok($doc, "got doc for '$action'");
+  like($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s,
+    'got the right doc');
+}
+
+{ # user typo'd the action name
+  ok( ! eval {$mb->get_action_docs('batz'); 1}, 'slap');
+  like($@, qr/No known action 'batz'/, 'informative error');
+}
+
+{ # XXX this one needs some thought
+  my $action = 'help';
+  my $doc = $mb->get_action_docs($action);
+  ok($doc, "got doc for '$action'");
+  0 and warn "help doc >\n$doc<\n";
+  TODO: {
+    local $TODO = 'Do we allow overrides on just docs?';
+    unlike($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s,
+      'got the right doc');
+  }
+}
+} # end =item style
+$restart->();
+########################################################################
+if(0) { # the =item style without spanning =head1 sections
+my $mb = Module::Build->subclass(
+  code => join "\n", map {s/^ {4}//; $_} split /\n/, <<'  ---',
+    =head1 ACTIONS
+
+    =over
+
+    =item foo
+
+    Does the foo thing.
+
+    =item bar
+
+    Does the bar thing.
+
+    =back
+
+    =head1 thbbt
+
+    =over
+
+    =item baz
+
+    Should not see this.
+
+    =back
+
+    =cut
+
+    sub ACTION_foo { die "fooey" }
+    sub ACTION_bar { die "barey" }
+    sub ACTION_baz { die "bazey" }
+
+  ---
+  )->new(
+      module_name => $dist->name,
+  );
+
+ok $mb;
+can_ok($mb, 'ACTION_foo');
+
+foreach my $action (qw(foo bar)) { # typical usage
+  my $doc = $mb->get_action_docs($action);
+  ok($doc, "got doc for '$action'");
+  like($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s,
+    'got the right doc');
+}
+is($mb->get_action_docs('baz'), undef, 'no jumping =head1 sections');
+
+} # end =item style without spanning =head1's
+$restart->();
+########################################################################
+TODO: { # the =item style with 'Actions' not 'ACTIONS'
+local $TODO = 'Support capitalized Actions section';
+my $mb = Module::Build->subclass(
+  code => join "\n", map {s/^ {4}//; $_} split /\n/, <<'  ---',
+    =head1 Actions
+
+    =over
+
+    =item foo
+
+    Does the foo thing.
+
+    =item bar
+
+    Does the bar thing.
+
+    =back
+
+    =cut
+
+    sub ACTION_foo { die "fooey" }
+    sub ACTION_bar { die "barey" }
+
+  ---
+  )->new(
+      module_name => $dist->name,
+  );
+
+foreach my $action (qw(foo bar)) { # typical usage
+  my $doc = $mb->get_action_docs($action);
+  ok($doc, "got doc for '$action'");
+  like($doc || 'undef', qr/^=\w+ $action\n\nDoes the $action thing\./s,
+    'got the right doc');
+}
+
+} # end =item style with Actions
+$restart->();
+########################################################################
+{ # check the =head2 style
+my $mb = Module::Build->subclass(
+  code => join "\n", map {s/^ {4}//; $_} split /\n/, <<'  ---',
+    =head1 ACTIONS
+
+    =head2 foo
+
+    Does the foo thing.
+
+    =head2 bar
+
+    Does the bar thing.
+
+    =head3 bears
+
+    Be careful with bears.
+
+    =cut
+
+    sub ACTION_foo { die "fooey" }
+    sub ACTION_bar { die "barey" }
+    sub ACTION_baz { die "bazey" }
+    sub ACTION_batz { die "batzey" }
+
+    # guess we can have extra pod later 
+    # Though, I do wonder whether we should allow them to mix...
+    # maybe everything should have to be head2?
+
+    =head2 baz
+
+    Does the baz thing.
+
+    =head4 What's a baz?
+
+    =head1 not this part
+
+    This is level 1, so the stuff about baz is done.
+
+    =head1 Thing
+
+    =head2 batz
+
+    This is not an action doc.
+
+    =cut
+
+  ---
+  )->new(
+      module_name => $dist->name,
+  );
+
+my %also = (
+  foo => '',
+  bar => "\n=head3 bears\n\nBe careful with bears.\n",
+  baz => "\n=head4 What's a baz\\?\n",
+);
+  
+foreach my $action (qw(foo bar baz)) {
+  my $doc = $mb->get_action_docs($action);
+  ok($doc, "got doc for '$action'");
+  my $and = $also{$action};
+  like($doc || 'undef',
+    qr/^=\w+ $action\n\nDoes the $action thing\.\n$and\n$/s,
+    'got the right doc');
+}
+is($mb->get_action_docs('batz'), undef, 'nothing after uplevel');
+
+} # end =head2 style
+########################################################################
+
+# cleanup
+$dist->clean();
+chdir( $cwd );
+File::Path::rmtree( $tmp );
+
+# vim:ts=2:sw=2:et:sta