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);$VERSION = '0.22';$VERSION = eval $VERSION;    # make the alpha version come out as a number# Make Test::Builder thread-safe for ithreads.BEGIN {    use Config;    # Load threads::shared when threads are turned on    if( $] >= 5.008 && $Config{useithreads} && $INC{'threads.pm'}) {        require threads::shared;        # Hack around YET ANOTHER threads::shared bug.  It would         # occassionally forget the contents of the variable when sharing it.        # So we first copy the data, then share, then put our copy back.        *share = sub (\[$@%]) {            my $type = ref $_[0];            my $data;            if( $type eq 'HASH' ) {                %$data = %{$_[0]};            }            elsif( $type eq 'ARRAY' ) {                @$data = @{$_[0]};            }            elsif( $type eq 'SCALAR' ) {                $$data = ${$_[0]};            }            else {                die "Unknown type: ".$type;            }            $_[0] = &threads::shared::share($_[0]);            if( $type eq 'HASH' ) {                %{$_[0]} = %$data;            }            elsif( $type eq 'ARRAY' ) {                @{$_[0]} = @$data;            }            elsif( $type eq 'SCALAR' ) {                ${$_[0]} = $$data;            }            else {                die "Unknown type: ".$type;            }            return $_[0];        };    }    # 5.8.0's threads::shared is busted when threads are off.    # We emulate it here.    else {        *share = sub { return $_[0] };        *lock  = sub { 0 };    }}=head1 NAMETest::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 DESCRIPTIONTest::Simple and Test::More have proven to be popular testing modules,but they're not always flexible enough.  Test::Builder provides the abuilding block upon which to write your own test libraries I<which canwork together>.=head2 Construction=over 4=item B<new>  my $Test = Test::Builder->new;Returns a Test::Builder object representing the current state of thetest.Since you only run one test per program, there is B<one and only one>Test::Builder object.  No matter how many times you call new(), you'regetting the same object.  (This is called a singleton).=cutmy $Test = Test::Builder->new;sub new {    my($class) = shift;    $Test ||= bless ['Move along, nothing to see here'], $class;    return $Test;}=item B<reset>  $Test->reset;Reinitializes the Test::Builder singleton to its original state.Mostly useful for tests run in persistent environments where the sametest might be run multiple times in the same process.=cutmy $Test_Died;my $Have_Plan;my $No_Plan;my $Curr_Test;     share($Curr_Test);use vars qw($Level);my $Original_Pid;my @Test_Results;  share(@Test_Results);my $Exported_To;my $Expected_Tests;my $Skip_All;my $Use_Nums;my($No_Header, $No_Ending);$Test->reset;sub reset {    my ($self) = @_;    $Test_Died = 0;    $Have_Plan = 0;    $No_Plan   = 0;    $Curr_Test = 0;    $Level     = 1;    $Original_Pid = $$;    @Test_Results = ();    $Exported_To    = undef;    $Expected_Tests = 0;    $Skip_All = 0;    $Use_Nums = 1;    ($No_Header, $No_Ending) = (0,0);    $self->_dup_stdhandles unless $^C;    return undef;}=back=head2 Setting up testsThese methods are for setting up tests and declaring how many thereare.  You usually only want to call one of these methods.=over 4=item B<exported_to>  my $pack = $Test->exported_to;  $Test->exported_to($pack);Tells Test::Builder what package you exported your functions to.This is important for getting TODO tests right.=cutsub exported_to {    my($self, $pack) = @_;    if( defined $pack ) {        $Exported_To = $pack;    }    return $Exported_To;}=item B<plan>  $Test->plan('no_plan');  $Test->plan( skip_all => $reason );  $Test->plan( tests => $num_tests );A convenient way to set up your tests.  Call this and Test::Builderwill print the appropriate headers and take the appropriate actions.If you call plan(), don't call any of the other methods below.=cutsub plan {    my($self, $cmd, $arg) = @_;    return unless $cmd;    if( $Have_Plan ) {        die sprintf "You tried to plan twice!  Second plan at %s line %d\n",          ($self->caller)[1,2];    }    if( $cmd eq 'no_plan' ) {        $self->no_plan;    }    elsif( $cmd eq 'skip_all' ) {        return $self->skip_all($arg);    }    elsif( $cmd eq 'tests' ) {        if( $arg ) {            return $self->expected_tests($arg);        }        elsif( !defined $arg ) {            die "Got an undefined number of tests.  Looks like you tried to ".                "say how many tests you plan to run but made a mistake.\n";        }        elsif( !$arg ) {            die "You said to run 0 tests!  You've got to run something.\n";        }    }    else {        require Carp;        my @args = grep { defined } ($cmd, $arg);        Carp::croak("plan() doesn't understand @args");    }    return 1;}=item B<expected_tests>    my $max = $Test->expected_tests;    $Test->expected_tests($max);Gets/sets the # of tests we expect this test to run and prints outthe appropriate headers.=cutsub expected_tests {    my $self = shift;    my($max) = @_;    if( @_ ) {        die "Number of tests must be a postive integer.  You gave it '$max'.\n"          unless $max =~ /^\+?\d+$/ and $max > 0;        $Expected_Tests = $max;        $Have_Plan      = 1;        $self->_print("1..$max\n") unless $self->no_header;    }    return $Expected_Tests;}=item B<no_plan>  $Test->no_plan;Declares that this test will run an indeterminate # of tests.=cutsub no_plan {    $No_Plan    = 1;    $Have_Plan  = 1;}=item B<has_plan>  $plan = $Test->has_plan  Find out whether a plan has been defined. $plan is either C<undef> (no plan has been set), C<no_plan> (indeterminate # of tests) or an integer (the number of expected tests).=cutsub has_plan {	return($Expected_Tests) if $Expected_Tests;	return('no_plan') if $No_Plan;	return(undef);};=item B<skip_all>  $Test->skip_all;  $Test->skip_all($reason);Skips all the tests, using the given $reason.  Exits immediately with 0.=cutsub skip_all {    my($self, $reason) = @_;    my $out = "1..0";    $out .= " # Skip $reason" if $reason;    $out .= "\n";    $Skip_All = 1;    $self->_print($out) unless $self->no_header;    exit(0);}=back=head2 Running testsThese actually run the tests, analogous to the functions inTest::More.$name is always optional.=over 4=item B<ok>  $Test->ok($test, $name);Your basic test.  Pass if $test is true, fail if $test is false.  Justlike Test::Simple's ok().=cutsub ok {    my($self, $test, $name) = @_;    # $test might contain an object which we don't want to accidentally    # store, so we turn it into a boolean.    $test = $test ? 1 : 0;    unless( $Have_Plan ) {        require Carp;        Carp::croak("You tried to run a test without a plan!  Gotta have a plan.");    }    lock $Curr_Test;    $Curr_Test++;    # In case $name is a string overloaded object, force it to stringify.    $self->_unoverload(\$name);    $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;    You named your test '$name'.  You shouldn't use numbers for your test names.    Very confusing.ERR    my($pack, $file, $line) = $self->caller;    my $todo = $self->todo($pack);    $self->_unoverload(\$todo);    my $out;    my $result = &share({});    unless( $test ) {        $out .= "not ";        @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );    }    else {        @$result{ 'ok', 'actual_ok' } = ( 1, $test );    }    $out .= "ok";    $out .= " $Curr_Test" if $self->use_numbers;    if( defined $name ) {        $name =~ s|#|\\#|g;     # # in a name can confuse Test::Harness.        $out   .= " - $name";        $result->{name} = $name;    }    else {        $result->{name} = '';    }    if( $todo ) {        $out   .= " # TODO $todo";        $result->{reason} = $todo;        $result->{type}   = 'todo';    }    else {        $result->{reason} = '';        $result->{type}   = '';    }    $Test_Results[$Curr_Test-1] = $result;    $out .= "\n";    $self->_print($out);    unless( $test ) {        my $msg = $todo ? "Failed (TODO)" : "Failed";        $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};        $self->diag("    $msg test ($file at line $line)\n");    }     return $test ? 1 : 0;}sub _unoverload {    my $self  = shift;    local($@,$!);    eval { require overload } || return;    foreach my $thing (@_) {        eval {             if( defined $$thing ) {                if( my $string_meth = overload::Method($$thing, '""') ) {                    $$thing = $$thing->$string_meth();                }            }        };    }}=item B<is_eq>  $Test->is_eq($got, $expected, $name);Like Test::More's is().  Checks if $got eq $expected.  This is thestring version.=item B<is_num>  $Test->is_num($got, $expected, $name);Like Test::More's is().  Checks if $got == $expected.  This is thenumeric version.=cutsub is_eq {    my($self, $got, $expect, $name) = @_;    local $Level = $Level + 1;    if( !defined $got || !defined $expect ) {        # undef only matches undef and nothing else        my $test = !defined $got && !defined $expect;        $self->ok($test, $name);        $self->_is_diag($got, 'eq', $expect) unless $test;        return $test;    }    return $self->cmp_ok($got, 'eq', $expect, $name);}sub is_num {    my($self, $got, $expect, $name) = @_;    local $Level = $Level + 1;    if( !defined $got || !defined $expect ) {        # undef only matches undef and nothing else        my $test = !defined $got && !defined $expect;        $self->ok($test, $name);        $self->_is_diag($got, '==', $expect) unless $test;        return $test;    }    return $self->cmp_ok($got, '==', $expect, $name);}sub _is_diag {    my($self, $got, $type, $expect) = @_;    foreach my $val (\$got, \$expect) {        if( defined $$val ) {            if( $type eq 'eq' ) {                # quote and force string context                $$val = "'$$val'"            }            else {                # force numeric context                $$val = $$val+0;            }        }        else {            $$val = 'undef';        }    }    return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);         got: %s    expected: %sDIAGNOSTIC}    =item B<isnt_eq>  $Test->isnt_eq($got, $dont_expect, $name);