view release on metacpan or  search on metacpan

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

    $Opened_Testhandles = 1;
}


sub _copy_io_layers {
    my($self, $src, $dst) = @_;
    
    $self->_try(sub {
        require PerlIO;
        my @src_layers = PerlIO::get_layers($src);

        binmode $dst, join " ", map ":$_", @src_layers if @src_layers;
    });
}

#line 1423

sub _message_at_caller {
    my $self = shift;

    local $Level = $Level + 1;
    my($pack, $file, $line) = $self->caller;
    return join("", @_) . " at $file line $line.\n";
}

sub carp {
    my $self = shift;
    warn $self->_message_at_caller(@_);
}

sub croak {
    my $self = shift;
    die $self->_message_at_caller(@_);
}

sub _plan_check {
    my $self = shift;

    unless( $self->{Have_Plan} ) {
        local $Level = $Level + 2;
        $self->croak("You tried to run a test without a plan");
    }
}

#line 1471

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

    lock($self->{Curr_Test});
    if( defined $num ) {
        unless( $self->{Have_Plan} ) {
            $self->croak("Can't change the current test number without a plan!");
        }

        $self->{Curr_Test} = $num;

        # If the test counter is being pushed forward fill in the details.
        my $test_results = $self->{Test_Results};
        if( $num > @$test_results ) {
            my $start = @$test_results ? @$test_results : 0;
            for ($start..$num-1) {
                $test_results->[$_] = &share({
                    'ok'      => 1, 
                    actual_ok => undef, 
                    reason    => 'incrementing test number', 
                    type      => 'unknown', 
                    name      => undef 
                });
            }
        }
        # If backward, wipe history.  Its their funeral.
        elsif( $num < @$test_results ) {
            $#{$test_results} = $num - 1;
        }
    }
    return $self->{Curr_Test};
}


#line 1516

sub summary {
    my($self) = shift;

    return map { $_->{'ok'} } @{ $self->{Test_Results} };
}

#line 1571

sub details {
    my $self = shift;
    return @{ $self->{Test_Results} };
}

#line 1597

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

    return $self->{TODO} if defined $self->{TODO};

    $pack = $pack || $self->caller(1) || $self->exported_to;
    return 0 unless $pack;

    no strict 'refs';   ## no critic
    return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
                                     : 0;
}

#line 1622

sub caller {
    my($self, $height) = @_;
    $height ||= 0;

    my @caller = CORE::caller($self->level + $height + 1);
    return wantarray ? @caller : $caller[0];
}

#line 1634