thread results from the CPAN

Attribute-Property

package Test::Builder;

use 5.004;

# $^C was only introduced in 5.005-ish.  We do this to prevent
# use of uninitialized value warnings in older perls.
$^C ||= 0;

use strict;
use vars qw($VERSION $CLASS);
$VERSION = '0.15';
$CLASS = __PACKAGE__;

my $IsVMS = $^O eq 'VMS';

use vars qw($Level);
my @Test_Results = ();
my @Test_Details = ();
my($Test_Died) = 0;
my($Have_Plan) = 0;
my $Curr_Test = 0;

# Make Test::Builder thread-safe for ithreads.
BEGIN {
    use Config;
    if( $] >= 5.008 && $Config{useithreads} ) {
        require threads;
        require threads::shared;
        threads::shared->import;
        share(\$Curr_Test);
        share(\@Test_Details);
        share(\@Test_Results);
    }
    else {
        *lock = sub { 0 };
    }
}


=head1 NAME

Test::Builder - Backend for building test libraries

=head1 SYNOPSIS

  package My::Test::Module;
  use Test::Builder;
  require Exporter;
  @ISA = qw(Exporter);
  @EXPORT = qw(ok);

  my $Test = Test::Builder->new;
  $Test->output('my_logfile');

  sub import {
      my($self) = shift;
      my $pack = caller;

      $Test->exported_to($pack);
      $Test->plan(@_);

      $self->export_to_level(1, $self, 'ok');
  }

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

      $Test->ok($test, $name);
  }


=head1 DESCRIPTION

Test::Simple and Test::More have proven to be popular testing modules,
but they're not always flexible enough.  Test::Builder provides the a
building block upon which to write your own test libraries I<which can
work together>.

=head2 Construction

=over 4

=item B<new>

  my $Test = Test::Builder->new;

Returns a Test::Builder object representing the current state of the
test.

t/lib/Test/Builder.pm view on Meta::CPAN

If you're running under no_plan, it skips once and terminates the
test.

=end _unimplemented

=back


=head2 Test style

=over 4

=item B<level>

    $Test->level($how_high);

How far up the call stack should $Test look when reporting where the
test failed.

Defaults to 1.

Setting $Test::Builder::Level overrides.  This is typically useful
localized:

    {
        local $Test::Builder::Level = 2;
        $Test->ok($test);
    }

=cut

sub level {
    my($self, $level) = @_;

    if( defined $level ) {
        $Level = $level;
    }
    return $Level;
}

$CLASS->level(1);


=item B<use_numbers>

    $Test->use_numbers($on_or_off);

Whether or not the test should output numbers.  That is, this if true:

  ok 1
  ok 2
  ok 3

or this if false

  ok
  ok
  ok

Most useful when you can't depend on the test output order, such as
when threads or forking is involved.

Test::Harness will accept either, but avoid mixing the two styles.

Defaults to on.

=cut

my $Use_Nums = 1;
sub use_numbers {
    my($self, $use_nums) = @_;

    if( defined $use_nums ) {
        $Use_Nums = $use_nums;
    }
    return $Use_Nums;
}

=item B<no_header>

    $Test->no_header($no_header);

If set to true, no "1..N" header will be printed.

=item B<no_ending>

    $Test->no_ending($no_ending);

Normally, Test::Builder does some extra diagnostics when the test
ends.  It also changes the exit code as described in Test::Simple.

If this is true, none of that will be done.

=cut

my($No_Header, $No_Ending) = (0,0);
sub no_header {
    my($self, $no_header) = @_;

    if( defined $no_header ) {
        $No_Header = $no_header;
    }
    return $No_Header;
}

sub no_ending {
    my($self, $no_ending) = @_;

    if( defined $no_ending ) {
        $No_Ending = $no_ending;
    }
    return $No_Ending;
}


=back

=head2 Output

Controlling where the test output goes.

t/lib/Test/Builder.pm view on Meta::CPAN

        die <<WHOA;
WHOA!  $desc
This should never happen!  Please contact the author immediately!
WHOA
    }
}

=item B<_my_exit>

  _my_exit($exit_num);

Perl seems to have some trouble with exiting inside an END block.  5.005_03
and 5.6.1 both seem to do odd things.  Instead, this function edits $?
directly.  It should ONLY be called from inside an END block.  It
doesn't actually exit, that's your job.

=cut

sub _my_exit {
    $? = $_[0];

    return 1;
}


=back

=end _private

=cut

$SIG{__DIE__} = sub {
    # We don't want to muck with death in an eval, but $^S isn't
    # totally reliable.  5.005_03 and 5.6.1 both do the wrong thing
    # with it.  Instead, we use caller.  This also means it runs under
    # 5.004!
    my $in_eval = 0;
    for( my $stack = 1;  my $sub = (CORE::caller($stack))[3];  $stack++ ) {
        $in_eval = 1 if $sub =~ /^\(eval\)/;
    }
    $Test_Died = 1 unless $in_eval;
};

sub _ending {
    my $self = shift;

    _sanity_check();

    # Bailout if plan() was never called.  This is so
    # "require Test::Simple" doesn't puke.
    do{ _my_exit(0) && return } if !$Have_Plan;

    # Figure out if we passed or failed and print helpful messages.
    if( @Test_Results ) {
        # The plan?  We have no plan.
        if( $No_Plan ) {
            $self->_print("1..$Curr_Test\n") unless $self->no_header;
            $Expected_Tests = $Curr_Test;
        }

        # 5.8.0 threads bug.  Shared arrays will not be auto-extended 
        # by a slice.
        $Test_Results[$Expected_Tests-1] = undef
          unless defined $Test_Results[$Expected_Tests-1];

        my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1];
        $num_failed += abs($Expected_Tests - @Test_Results);

        if( $Curr_Test < $Expected_Tests ) {
            $self->diag(<<"FAIL");
Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
FAIL
        }
        elsif( $Curr_Test > $Expected_Tests ) {
            my $num_extra = $Curr_Test - $Expected_Tests;
            $self->diag(<<"FAIL");
Looks like you planned $Expected_Tests tests but ran $num_extra extra.
FAIL
        }
        elsif ( $num_failed ) {
            $self->diag(<<"FAIL");
Looks like you failed $num_failed tests of $Expected_Tests.
FAIL
        }

        if( $Test_Died ) {
            $self->diag(<<"FAIL");
Looks like your test died just after $Curr_Test.
FAIL

            _my_exit( 255 ) && return;
        }

        _my_exit( $num_failed <= 254 ? $num_failed : 254  ) && return;
    }
    elsif ( $Skip_All ) {
        _my_exit( 0 ) && return;
    }
    else {
        $self->diag("No tests run!\n");
        _my_exit( 255 ) && return;
    }
}

END {
    $Test->_ending if defined $Test and !$Test->no_ending;
}

=head1 THREADS

In perl 5.8.0 and later, Test::Builder is thread-safe.  The test
number is shared amongst all threads.  This means if one thread sets
the test number using current_test() they will all be effected.

=head1 EXAMPLES

CPAN can provide the best examples.  Test::Simple, Test::More,
Test::Exception and Test::Differences all use Test::Builder.

=head1 SEE ALSO

Test::Simple, Test::More, Test::Harness

=head1 AUTHORS

Original code by chromatic, maintained by Michael G Schwern
E<lt>schwern@pobox.comE<gt>

=head1 COPYRIGHT

Copyright 2001 by chromatic E<lt>chromatic@wgz.orgE<gt>,
                  Michael G Schwern E<lt>schwern@pobox.comE<gt>.

This program is free software; you can redistribute it and/or 
modify it under the same terms as Perl itself.

See F<http://www.perl.com/perl/misc/Artistic.html>

=cut

1;

( run in 1.090 second using v1.01-cache-2.11-cpan-99c4e6809bf )