view release on metacpan or  search on metacpan

src/inc/Test/Builder.pm  view on Meta::CPAN

        }
    }
    else {
        require Carp;
        my @args = grep { defined } ($cmd, $arg);
        Carp::croak("plan() doesn't understand @args");
    }

    return 1;
}


my $Expected_Tests = 0;
sub expected_tests {
    my($self, $max) = @_;

    if( defined $max ) {
        $Expected_Tests = $max;
        $Have_Plan      = 1;

        $self->_print("1..$max\n") unless $self->no_header;
    }
    return $Expected_Tests;
}



my($No_Plan) = 0;
sub no_plan {
    $No_Plan    = 1;
    $Have_Plan  = 1;
}


sub has_plan {
	return($Expected_Tests) if $Expected_Tests;
	return('no_plan') if $No_Plan;
	return(undef);
};



my $Skip_All = 0;
sub 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);
}


sub 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++;

    $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);

    my $out;
    my $result = {};
    share($result);

    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 ) {
        my $what_todo = $todo;
        $out   .= " # TODO $what_todo";
        $result->{reason} = $what_todo;
        $result->{type}   = 'todo';
    }
    else {
        $result->{reason} = '';
        $result->{type}   = '';
    }

    $Test_Results[$Curr_Test-1] = $result;
    $out .= "\n";

    $self->_print($out);