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


line stmt bran cond sub pod time code
1             package VSGDR::UnitTest::TestSet::Test;
2              
3 1     1   27 use 5.010;
  1         5  
4 1     1   8 use strict;
  1         3  
  1         32  
5 1     1   8 use warnings;
  1         3  
  1         40  
6              
7              
8             #our \$VERSION = '1.01';
9              
10              
11 1     1   7 use Data::Dumper ;
  1         2  
  1         87  
12 1     1   8 use Carp ;
  1         3  
  1         96  
13              
14              
15 1     1   15 use vars qw($AUTOLOAD);
  1         3  
  1         3208  
16             my %ok_field;
17              
18             # Authorize four attribute fields
19             {
20             #for my $attr ( qw(nameSpace className testName testDataName ) ) { $ok_field{$attr}++; }
21             #for my $attr ( qw(testName testActionDataName postTestAction testAction preTestAction) ) { $ok_field{$attr}++; }
22             for my $attr ( qw(testName testActionDataName ) ) { $ok_field{$attr}++; }
23             }
24             sub new {
25              
26 0     0 0   local $_ = undef ;
27              
28             #warn Dumper @_;
29              
30 0           my $invocant = shift ;
31 0   0       my $class = ref($invocant) || $invocant ;
32              
33 0           my @elems = @_ ;
34 0           my $self = bless {}, $class ;
35            
36 0           $self->_init(@elems) ;
37 0           return $self ;
38             }
39              
40              
41             sub _init {
42              
43 0     0     local $_ = undef ;
44              
45             #warn Dumper @_;
46              
47 0           my $self = shift ;
48 0   0       my $class = ref($self) || $self ;
49 0 0         my $ref = shift or croak "no arg";
50              
51             #print Dumper $ref ;
52              
53 0           for my $attr ( qw(TESTNAME TESTACTIONDATANAME PRETESTACTION TESTACTION POSTTESTACTION ) ) { $self->{OK_PARAMS}{$attr}++; }
  0            
54 0           my @validargs = grep { $$ref{$_} } keys %{$self->{OK_PARAMS}} ;
  0            
  0            
55             #warn Dumper @validargs ;
56 0 0         croak "bad args"
57             if scalar(@validargs) != 5 ;
58              
59              
60 0           my ${TestName} = $$ref{TESTNAME};
61 0           my ${TestActionDataName} = $$ref{TESTACTIONDATANAME};
62 0           my ${PreTestAction} = $$ref{PRETESTACTION};
63 0           my ${TestAction} = $$ref{TESTACTION};
64 0           my ${PostTestAction} = $$ref{POSTTESTACTION};
65              
66 0           $self->testName(${TestName}) ;
67 0           $self->testActionDataName(${TestActionDataName}) ;
68 0           $self->preTestAction(${PreTestAction}) ;
69 0           $self->testAction(${TestAction}) ;
70 0           $self->postTestAction(${PostTestAction}) ;
71            
72 0           $self->{TESTCONDITIONS} = [] ;
73            
74 0           $self->{PRETEST_TESTCONDITIONS} = [] ;
75 0           $self->{TEST_TESTCONDITIONS} = [] ;
76 0           $self->{POSTTEST_TESTCONDITIONS} = [] ;
77            
78             #multiple tests
79             #each with multiple actions
80             #each with multiple conditions
81              
82             # $self->testName(${TestName}) ;
83             # $self->testDataName(${TestDataName}) ;
84            
85 0           return ;
86            
87             }
88              
89             #-- TODO --->
90             sub actions {
91 0 0   0 0   my $self = shift or croak 'no self';
92 0           my %actions ;
93              
94 0 0         if ( $self->preTestAction() !~ m/^(?:null|nothing)$/ix ) { $actions{$self->testName()."_".$self->preTestAction()} = 1; }
  0            
95 0 0         if ( $self->testAction() !~ m/^(?:null|nothing)$/ix ) { $actions{$self->testName()."_".$self->testAction()} = 1; }
  0            
96 0 0         if ( $self->postTestAction() !~ m/^(?:null|nothing)$/ix ) { $actions{$self->testName()."_".$self->postTestAction()} = 1; }
  0            
97            
98 0           return \%actions ;
99             }
100              
101             #sub hasAction {
102             # my $self = shift or croak 'no self';
103             # my $action = shift ;
104             # croak 'No action requested' if not defined $action;
105             # return exists($self->{ACTIONS}{$action}) ;
106             #}
107              
108              
109              
110             sub preTestActionLiteral {
111 0     0 0   my $self = shift;
112 0           return "PretestAction";
113             }
114             sub testActionLiteral {
115 0     0 0   my $self = shift;
116 0           return "TestAction";
117             }
118             sub postTestActionLiteral {
119 0     0 0   my $self = shift;
120 0           return "PosttestAction";
121             }
122              
123             sub preTestActionLiteralName {
124 0     0 0   my $self = shift;
125 0           return $self->testName . '_' . $self->preTestActionLiteral() ;
126             }
127             sub testActionLiteralName {
128 0     0 0   my $self = shift;
129 0           return $self->testName . '_' . $self->testActionLiteral() ;
130             }
131             sub postTestActionLiteralName {
132 0     0 0   my $self = shift;
133 0           return $self->testName . '_' . $self->postTestActionLiteral() ;
134             }
135              
136             sub commentifyTestName {
137 0     0 0   my $self = shift;
138 0 0         my $commentChars = shift or croak 'No Chars' ;
139 0           return <<"EOF";
140             ${commentChars}
141 0           ${commentChars}@{[$self->testName()]}
142             ${commentChars}
143             EOF
144             }
145              
146              
147             sub commentifyPreTestAction {
148 0     0 0   my $self = shift;
149 0 0         my $commentChars = shift or croak 'No Chars' ;
150 0           return <<"EOF";
151             ${commentChars}
152 0           ${commentChars}@{[$self->preTestAction()]}
153             ${commentChars}
154             EOF
155             }
156              
157             sub commentifyTestAction {
158 0     0 0   my $self = shift;
159 0 0         my $commentChars = shift or croak 'No Chars' ;
160 0           return <<"EOF";
161             ${commentChars}
162 0           ${commentChars}@{[$self->testAction()]}
163             ${commentChars}
164             EOF
165             }
166              
167             sub commentifyPostTestAction {
168 0     0 0   my $self = shift;
169 0 0         my $commentChars = shift or croak 'No Chars' ;
170 0           return <<"EOF";
171             ${commentChars}
172 0           ${commentChars}@{[$self->postTestAction()]}
173             ${commentChars}
174             EOF
175             }
176              
177             sub commentifyActionDataName {
178 0     0 0   my $self = shift;
179 0 0         my $commentChars = shift or croak 'No Chars' ;
180 0           return <<"EOF";
181             ${commentChars}
182 0           ${commentChars}@{[$self->testActionDataName()]}
183             ${commentChars}
184             EOF
185             }
186              
187             sub preTest_conditions {
188 0 0   0 0   my $self = shift or croak 'no self';
189 0           my $conditions ;
190 0 0         $conditions = shift if @_;
191 0 0         if ( defined $conditions ) {
192 0           my @conditions = @$conditions ;
193 0           $self->{PRETEST_TESTCONDITIONS} = \@conditions ;
194             }
195 0           return $self->{PRETEST_TESTCONDITIONS} ;
196             }
197              
198             sub test_conditions {
199 0 0   0 0   my $self = shift or croak 'no self';
200 0           my $conditions ;
201 0 0         $conditions = shift if @_;
202 0 0         if ( defined $conditions ) {
203 0           my @conditions = @$conditions ;
204 0           $self->{TEST_TESTCONDITIONS} = \@conditions ;
205             }
206 0           return $self->{TEST_TESTCONDITIONS} ;
207             }
208              
209             sub postTest_conditions {
210 0 0   0 0   my $self = shift or croak 'no self';
211 0           my $conditions ;
212 0 0         $conditions = shift if @_;
213 0 0         if ( defined $conditions ) {
214 0           my @conditions = @$conditions ;
215 0           $self->{POSTTEST_TESTCONDITIONS} = \@conditions ;
216             }
217 0           return $self->{POSTTEST_TESTCONDITIONS} ;
218             }
219              
220             sub conditions {
221 0 0   0 0   my $self = shift or croak 'no self';
222 0           my $conditions ;
223 0 0         $conditions = shift if @_;
224 0 0         if ( defined $conditions ) {
225 0           croak 'obsoleted method' ;
226             }
227 0           my $preTestConditions = $self->preTest_conditions() ;
228 0           my $testConditions = $self->test_conditions() ;
229 0           my $postTestConditions = $self->postTest_conditions() ;
230 0           my @Conditions = flatten ([@$preTestConditions,@$testConditions,@$postTestConditions]);
231            
232 0           return \@Conditions ;
233             }
234              
235             sub preTestAction {
236 0 0   0 0   my $self = shift or croak 'no self';
237 0           my $action ;
238 0 0         $action = shift if @_;
239             # normalise
240 0 0         if ( defined $action ) {
241 0 0         $action = 'null' if $action =~ m{^null|nothing$}ix ;
242 0           $self->{PRETESTACTION} = $action ;
243             }
244 0           return $self->{PRETESTACTION} ;
245              
246             }
247             sub testAction {
248 0 0   0 0   my $self = shift or croak 'no self';
249 0           my $action ;
250 0 0         $action = shift if @_;
251             # normalise
252 0 0         if ( defined $action ) {
253 0 0         $action = 'null' if $action =~ m{^null|nothing$}ix ;
254 0           $self->{TESTACTION} = $action ;
255             }
256 0           return $self->{TESTACTION} ;
257              
258             }
259             sub postTestAction {
260 0 0   0 0   my $self = shift or croak 'no self';
261 0           my $action ;
262 0 0         $action = shift if @_;
263             # normalise
264 0 0         if ( defined $action ) {
265 0 0         $action = 'null' if $action =~ m{^null|nothing$}ix ;
266 0           $self->{POSTTESTACTION} = $action ;
267             }
268 0           return $self->{POSTTESTACTION} ;
269              
270             }
271              
272              
273 0     0 0   sub flatten { return map { @$_} @_ } ;
  0            
274              
275       0     sub DESTROY {}
276              
277             sub AUTOLOAD {
278 0     0     my $self = shift;
279 0           my $attr = $AUTOLOAD;
280 0           $attr =~ s{.*::}{}x;
281 0 0         return unless $attr =~ m{[^A-Z]}x; # skip DESTROY and all-cap methods
282 0 0         croak "invalid attribute method: ->$attr()" unless $ok_field{$attr};
283 0 0         $self->{uc $attr} = shift if @_;
284 0           return $self->{uc $attr};
285             }
286              
287             1 ;
288              
289             __DATA__