File Coverage

blib/lib/Test/Stream/Workflow/Unit.pm

Criterion	Covered	Total	%
statement	101	101	100.0
branch	33	42	78.5
condition	37	46	80.4
subroutine	19	19	100.0
pod	6	7	85.7
total	196	215	91.1

package Test::Stream::Workflow::Unit;
use strict;
use warnings;

use Test::Stream::Sync;
use Test::Stream::Context();
use Test::Stream::DebugInfo;

use Carp qw/confess/;
use Scalar::Util qw/reftype/;

use Test::Stream::HashBase(
    accessors => [qw{
        name meta type wrap stash
        package file start_line end_line
        post
        modify
        buildup
        primary
        teardown
        is_root
    }],
);

sub init {
    $_[0]->{+META} ||= {};

    for (NAME, PACKAGE, FILE, START_LINE, END_LINE) {
        confess "$_ is a required attribute" unless defined $_[0]->{$_}
    }

    $_[0]->{+STASH} ||= {};
}

sub contains {
    my $self = shift;
    my ($thing) = @_;
    my ($file, $line, $name);
    if ($thing =~ m/^(\S+) (\d+)$/) {
        ($file, $line) = ($1, $2);
    }
    elsif ($thing =~ m/^\d+$/) {
        $line = $thing;
    }
    else {
        $name = $thing;
    }

    return $self->_contains($file, $line, $name);
}

sub _contains {
    my $self = shift;
    my ($file, $line, $name) = @_;

    my $name_ok = !defined($name) || $self->{+NAME} eq $name;
    my $file_ok = !defined($file) || $self->{+FILE} eq $file;

    my $line_ok = !defined($line) || (
        $line >= $self->{+START_LINE}
        && ($self->{+END_LINE} . "" eq 'EOF' || $line <= $self->{+END_LINE})
    );

    my $child_ok = 0;
    for my $stash (MODIFY(), BUILDUP(), PRIMARY(), TEARDOWN()) {
        my $set = $self->$stash || next;
        next unless ref $set && reftype($set) eq 'ARRAY';
        for my $unit (@$set) {
            $child_ok = 1 if $unit->_contains($file, $line, $name);
        }
    }

    return $child_ok || ($name_ok && $file_ok && $line_ok);
}

sub do_post {
    my $self = shift;

    my $post = delete $self->{+POST} or return;
    $_->($self) for @$post;
}

for my $type (MODIFY(), BUILDUP(), PRIMARY(), TEARDOWN()) {
    no strict 'refs';
    *{"add_$type"} = sub {
        use strict;
        my $self = shift;
        $self->{$type} ||= [];
        push @{$self->{$type}} => @_;
    };
}

sub adjust_lines {
    my $self = shift;

    my $start = $self->{+START_LINE};
    my $end   = $self->{+END_LINE};

    for my $stash (MODIFY(), BUILDUP(), PRIMARY(), TEARDOWN()) {
        my $list = $self->{$stash} or next;
        next unless ref $list;
        next unless reftype($list) eq 'ARRAY';
        next unless @$list;

        my $top = $list->[0] or next;

        my $c_start = $top->start_line;
        my $c_end   = $top->end_line;

        $start = $c_start
            if defined($c_start)
            && $c_start =~ m/^\d+$/
            && $c_start < $start;

        next if $end && "$end" eq 'EOF';
        next unless defined $c_end;

        $end = $c_end
            if ($c_end =~ m/^\d+$/ && $c_end > $end)
            || "$c_end" eq 'EOF';
    }

    if ("$end" eq 'EOF') {
        $start -= 1 if $start != $self->{+START_LINE};
    }
    else {
        $start -= 1 if $start != $end && $start != $self->{+START_LINE};
        $end   += 1 if $end != $start && $end   != $self->{+END_LINE};
    }

    $self->{+START_LINE} = $start;
    $self->{+END_LINE}   = $end;
}

sub add_post {
    my $self = shift;
    confess "post units only apply to group units"
        unless $self->type eq 'group';
    $self->{post} ||= [];
    push @{$self->{post}} => @_;
}

sub debug {
    my $self = shift;

    my $stack = Test::Stream::Sync->stack;
    my $hub   = $stack->top;

    return Test::Stream::DebugInfo->new(
        frame       => [@$self{qw/package file start_line name/}],
        skip        => $self->meta->{skip},
        detail => "in block '$self->{+NAME}' defined in $self->{+FILE} (Approx) lines $self->{+START_LINE} -> $self->{+END_LINE}",
        $hub->debug_todo,
    );
}

sub context {
    my $self = shift;

    my $stack = Test::Stream::Sync->stack;
    my $hub   = $stack->top;

    my $ref;
    if(my $todo = $self->meta->{todo}) {
        $ref = $hub->set_todo($todo);
    }

    my $dbg = $self->debug;

    my $ctx = Test::Stream::Context->new(
        stack => $stack,
        hub   => $hub,
        debug => $dbg,
    );

    # Stash the todo ref in the context so that it goes away with the context
    $ctx->{_todo_ref} = $ref;

    return $ctx;
}

1;

__END__