view release on metacpan or  search on metacpan

lib/Test/Group.pm  view on Meta::CPAN

=item 2

otherwise, if any subtest failed outside of a TODO block, the group
fails.

=item 3

otherwise, if any subtest B<succeeds> inside of a TODO block, the
group is flagged as an unexpected success.

=item 4

otherwise, if any subtest fails inside of a TODO block, the group
results in a TODO (excused) failure.

=item 5

otherwise, the test group managed to avert all hazards and is a
straight success (tada!!).

=back

If any sub-tests failed in I<$groupsub>, diagnostics will be
propagated using L<Test::Builder/diag> as usual.

The return value of I<test> is 1 if the test group is a success
(including a TODO unexpected success), 0 if it is a failure (including
a TODO excused failure), and undef if the test group was skipped.

=cut

sub test ($&) {
    my ($name, $code) = @_;

    my ($callerpackage) = caller(0);

    my $Test = Test::Builder->new; # This is a singleton actually -
    # it should read "Test::Builder->the()" with permission from
    # Michael Schwern :-)

    my $subTest = Test::Group::_Runner->new($name, $callerpackage, $code);
    $subTest->run();

    if ($subTest->is_skipped) {
        $Test->skip($subTest->skip_reason);
        return;
    }

    if ($subTest->got_exception) {
        my $exn = $subTest->exception();
        my $exntext =
            ( ! defined $exn ? "an undefined exception" :
              eval { $exn->can("stringify") } ? $exn->stringify :
              (ref($exn) && $Data::Dumper::VERSION ) ? do {
                  no warnings "once";
                  local $Data::Dumper::Indent = 1;
                  local $Data::Dumper::Terse = 1;
                  Data::Dumper::Dumper($exn) } :
               "$exn" ? "$exn" : "a blank exception" );
        { local $/ = ""; chomp($exntext); }
        my $message = <<"MESSAGE";
Test ``$name'' died:
$exntext
MESSAGE
        if ($classstate_logfd) {
            print $classstate_logfd $message;
            $Test->diag("test ``$name'' died - "
                    . "see log file: ``$classstate_logfile''");
        } else {
            $Test->diag($message);
        };
        $name = "*died* $name";
    }

    return $subTest->{result} if exists $subTest->{result};

    no warnings "redefine";
    my ($OK, $TODO_string) = $subTest->as_Test_Builder_params;
    # I tried to put a "local $TODO = " here, but that didn't work and
    # I lack the patience to dig up the whole story about
    # Test::Builder->caller not doing The Right Thing here (yet
    # elsewhere it does when it apparently shouldn't, e.g. in
    # L</run>).  So here goes a sleazy local-method trick to get the
    # TODO status across to Test::Builder; the trick has an adherence
    # in L</ok>, which see.
    local *Test::Builder::todo = sub { $TODO_string };
    local *Test::Builder::in_todo = sub { defined($TODO_string) };
    local $Test::Builder::Level = $Test::Builder::Level + $Level;
    $Test->ok($OK, $name);
    return $OK ? 1 : 0;
}

=head3 skip_next_tests ($number)

=head3 skip_next_tests ($number, $reason)

Skips the $number following groups of tests with reason $reason.  Dies
if we are currently skipping tests already.

=head3 skip_next_test ()

=head3 skip_next_test ($reason)

Equivalent to:

    skip_next_tests 1;
    skip_next_tests 1, $reason;

=head3 begin_skipping_tests ()

    begin_skipping_tests;
    begin_skipping_tests "reason";

Skips all subsequent groups of tests until blocked by
L</end_skipping_tests>.

=head3 end_skipping_tests ()

Cancels the effect of L</begin_skipping_tests>. Has no effect if we
are not currently skipping tests.