File Coverage

blib/lib/VSGDR/UnitTest/TestSet/Test.pm

Criterion	Covered	Total	%
statement	17	151	11.2
branch	0	76	0.0
condition	0	6	0.0
subroutine	6	30	20.0
pod	0	21	0.0
total	23	284	8.1

package VSGDR::UnitTest::TestSet::Test;

use 5.010;
use strict;
use warnings;


#our \$VERSION = '1.01';


use Data::Dumper ;
use Carp ;


use vars qw($AUTOLOAD);
my %ok_field;

# Authorize four attribute fields
{
#for my $attr ( qw(nameSpace className testName testDataName ) ) { $ok_field{$attr}++; }
#for my $attr ( qw(testName testActionDataName postTestAction testAction preTestAction) ) { $ok_field{$attr}++; }
for my $attr ( qw(testName testActionDataName ) ) { $ok_field{$attr}++; }
}
sub new {

    local $_ = undef ;

#warn Dumper @_;

    my $invocant         = shift ;
    my $class            = ref($invocant) || $invocant ;

    my @elems            = @_ ;
    my $self             = bless {}, $class ;

    $self->_init(@elems) ;
    return $self ;
}


sub _init {

    local $_ = undef ;

#warn Dumper @_;

    my $self                = shift ;
    my $class               = ref($self) || $self ;
    my $ref = shift or croak "no arg";

#print Dumper $ref ;

    for my $attr ( qw(TESTNAME TESTACTIONDATANAME PRETESTACTION TESTACTION POSTTESTACTION ) ) { $self->{OK_PARAMS}{$attr}++; }
    my @validargs = grep { $$ref{$_} } keys %{$self->{OK_PARAMS}} ;
#warn Dumper @validargs ;
    croak "bad args"
        if scalar(@validargs) != 5 ;


    my ${TestName}              = $$ref{TESTNAME};
    my ${TestActionDataName}    = $$ref{TESTACTIONDATANAME};
    my ${PreTestAction}         = $$ref{PRETESTACTION};
    my ${TestAction}            = $$ref{TESTACTION};
    my ${PostTestAction}        = $$ref{POSTTESTACTION};

    $self->testName(${TestName}) ;
    $self->testActionDataName(${TestActionDataName}) ;
    $self->preTestAction(${PreTestAction}) ;
    $self->testAction(${TestAction}) ;
    $self->postTestAction(${PostTestAction}) ;

    $self->{TESTCONDITIONS}   = [] ;

    $self->{PRETEST_TESTCONDITIONS}     = [] ;
    $self->{TEST_TESTCONDITIONS}        = [] ;
    $self->{POSTTEST_TESTCONDITIONS}    = [] ;

#multiple tests
#each with multiple actions
#each with multiple conditions

#    $self->testName(${TestName}) ;
#    $self->testDataName(${TestDataName}) ;

    return ;

}

#-- TODO --->
sub actions {
    my $self       = shift or croak 'no self';
    my %actions ;

    if ( $self->preTestAction()  !~ m/^(?:null|nothing)$/ix ) { $actions{$self->testName()."_".$self->preTestAction()} = 1; }
    if ( $self->testAction()     !~ m/^(?:null|nothing)$/ix ) { $actions{$self->testName()."_".$self->testAction()} = 1; }
    if ( $self->postTestAction() !~ m/^(?:null|nothing)$/ix ) { $actions{$self->testName()."_".$self->postTestAction()} = 1; }

    return \%actions ;
}

#sub hasAction {
#    my $self       = shift or croak 'no self';
#    my $action     = shift ;
#    croak 'No action requested' if not defined $action;
#    return exists($self->{ACTIONS}{$action}) ;
#}



sub preTestActionLiteral {
    my $self            = shift;
    return "PretestAction";
}
sub testActionLiteral {
    my $self            = shift;
    return "TestAction";
}
sub postTestActionLiteral {
    my $self            = shift;
    return "PosttestAction";
}

sub preTestActionLiteralName {
    my $self            = shift;
    return $self->testName . '_' . $self->preTestActionLiteral() ;
}
sub testActionLiteralName {
    my $self            = shift;
    return $self->testName . '_' . $self->testActionLiteral() ;
}
sub postTestActionLiteralName {
    my $self            = shift;
    return $self->testName . '_' . $self->postTestActionLiteral() ;
}

sub commentifyTestName {
    my $self            = shift;
    my $commentChars    = shift or croak 'No Chars' ;
    return <<"EOF";
            ${commentChars}
            ${commentChars}@{[$self->testName()]}
            ${commentChars}
EOF
}


sub commentifyPreTestAction {
    my $self            = shift;
    my $commentChars    = shift or croak 'No Chars' ;
    return <<"EOF";
            ${commentChars}
            ${commentChars}@{[$self->preTestAction()]}
            ${commentChars}
EOF
}

sub commentifyTestAction {
    my $self            = shift;
    my $commentChars    = shift or croak 'No Chars' ;
    return <<"EOF";
            ${commentChars}
            ${commentChars}@{[$self->testAction()]}
            ${commentChars}
EOF
}

sub commentifyPostTestAction {
    my $self            = shift;
    my $commentChars    = shift or croak 'No Chars' ;
    return <<"EOF";
            ${commentChars}
            ${commentChars}@{[$self->postTestAction()]}
            ${commentChars}
EOF
}

sub commentifyActionDataName {
    my $self    = shift;
    my $commentChars    = shift or croak 'No Chars' ;
    return <<"EOF";
            ${commentChars}
            ${commentChars}@{[$self->testActionDataName()]}
            ${commentChars}
EOF
}

sub preTest_conditions {
    my $self            = shift or croak 'no self';
    my $conditions ;
    $conditions         = shift if @_;
    if ( defined $conditions ) {
        my @conditions      = @$conditions ;
        $self->{PRETEST_TESTCONDITIONS} = \@conditions ;
    }
    return $self->{PRETEST_TESTCONDITIONS} ;
}

sub test_conditions {
    my $self            = shift or croak 'no self';
    my $conditions ;
    $conditions         = shift if @_;
    if ( defined $conditions ) {
        my @conditions      = @$conditions ;
        $self->{TEST_TESTCONDITIONS} = \@conditions ;
    }
    return $self->{TEST_TESTCONDITIONS} ;
}

sub postTest_conditions {
    my $self            = shift or croak 'no self';
    my $conditions ;
    $conditions         = shift if @_;
    if ( defined $conditions ) {
        my @conditions      = @$conditions ;
        $self->{POSTTEST_TESTCONDITIONS} = \@conditions ;
    }
    return $self->{POSTTEST_TESTCONDITIONS} ;
}

sub conditions {
    my $self            = shift or croak 'no self';
    my $conditions ;
    $conditions         = shift if @_;
    if ( defined $conditions ) {
croak 'obsoleted method' ;
    }
    my $preTestConditions  = $self->preTest_conditions() ;
    my $testConditions     = $self->test_conditions() ;
    my $postTestConditions = $self->postTest_conditions() ;
    my @Conditions =  flatten ([@$preTestConditions,@$testConditions,@$postTestConditions]);

    return \@Conditions ;
}

sub preTestAction {
    my $self        = shift or croak 'no self';
    my $action ;
    $action         = shift if @_;
    # normalise
    if ( defined $action ) {
        $action = 'null' if $action =~ m{^null|nothing$}ix ;
        $self->{PRETESTACTION} = $action ;
    }
    return $self->{PRETESTACTION} ;

}
sub testAction {
    my $self        = shift or croak 'no self';
    my $action ;
    $action         = shift if @_;
    # normalise
    if ( defined $action ) {
        $action = 'null' if $action =~ m{^null|nothing$}ix ;
        $self->{TESTACTION} = $action ;
    }
    return $self->{TESTACTION} ;

}
sub postTestAction {
    my $self        = shift or croak 'no self';
    my $action ;
    $action         = shift if @_;
    # normalise
    if ( defined $action ) {
        $action = 'null' if $action =~ m{^null|nothing$}ix ;
        $self->{POSTTESTACTION} = $action ;
    }
    return $self->{POSTTESTACTION} ;

}


sub flatten { return map { @$_} @_ } ;

sub DESTROY {}

sub AUTOLOAD {
    my $self = shift;
    my $attr = $AUTOLOAD;
    $attr =~ s{.*::}{}x;
    return unless $attr =~ m{[^A-Z]}x;  # skip DESTROY and all-cap methods
    croak "invalid attribute method: ->$attr()" unless $ok_field{$attr};
    $self->{uc $attr} = shift if @_;
    return $self->{uc $attr};
}

1 ;

__DATA__