view release on metacpan or  search on metacpan

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

}

sub spec_string() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_string(shift);
    return $self;
}

sub filters() {
    (my ($self), @_) = find_my_self(@_);
    if (ref($_[0]) eq 'HASH') {
        $self->_filters_map(shift);
    }
    else {    
        my $filters = $self->_filters;
        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or
         not defined $expected or
         $actual eq $expected or 
         not($self->have_text_diff) or 
         $expected !~ /\n./s
    ) {
        Test::More::is($actual, $expected, $name);
    }
    else {
        $name = '' unless defined $name;
        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);
    }
}

my $name_error = "Can't determine section names";
sub _section_names {
    return @_ if @_ == 2;
    my $block = $self->first_block
      or croak $name_error;
    my @names = grep {
        $_ !~ /^(ONLY|LAST|SKIP)$/;
    } @{$block->{_section_order}[0] || []};
    croak "$name_error. Need two sections in first block"
      unless @names == 2;
    return @names;
}

sub _assert_plan {
    plan('no_plan') unless $Have_Plan;
}

sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});
        $block->run_filters unless $block->is_filtered;
        if (ref $block->$x) {
            is_deeply($block->$x, $block->$y,
                $block->name ? $block->name : ());
        }
        elsif (ref $block->$y eq 'Regexp') {
            my $regexp = ref $y ? $y : $block->$y;
            like($block->$x, $regexp, $block->name ? $block->name : ());
        }
        else {
            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});
        $block->run_filters unless $block->is_filtered;
        is($block->$x, $block->$y, 
           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});
        $block->run_filters unless $block->is_filtered;
        is_deeply($block->$x, $block->$y, 
           $block->name ? $block->name : ()
          );
    }
}