our
$VERSION
=
'1.000103'
;
use
Carp
qw/croak confess/
;
-job
-try
-assertion_count
-exit
-plan
-_errors
-_failures
-_sub_failures
-_plans
-_info
-_sub_info
-_subtest_id
-nested
-subtests
-numbers
-times
-halt
-failed_subtest_tree
}
;
sub
init {
my
$self
=
shift
;
croak
"'job' is a required attribute"
unless
$self
->{+JOB};
croak
"'try' is a required attribute"
unless
defined
$self
->{+TRY};
$self
->{+_FAILURES} = 0;
$self
->{+_ERRORS} = 0;
$self
->{+ASSERTION_COUNT} = 0;
$self
->{+NUMBERS} = {};
$self
->{+TIMES} = Test2::Harness::Auditor::TimeTracker->new();
$self
->{+NESTED} = 0
unless
defined
$self
->{+NESTED};
}
sub
pass { !
$_
[0]->fail }
sub
file {
$_
[0]->{+JOB}->{file} }
sub
fail { !!
$_
[0]->fail_error_facet_list }
sub
has_exit {
defined
$_
[0]->{+EXIT} }
sub
has_plan {
defined
$_
[0]->{+PLAN} }
sub
process {
my
$self
=
shift
;
my
(
$event
) =
@_
;
my
$f
=
$event
->{facet_data};
my
$hf
= hub_truth(
$f
);
my
$nested
=
$hf
->{nested} || 0;
$self
->
times
->process(
$event
,
$f
,
$self
->{+ASSERTION_COUNT})
unless
$nested
;
return
if
$hf
->{buffered};
my
$is_ours
=
$nested
==
$self
->{+NESTED};
return
unless
$is_ours
||
$f
->{from_tap};
if
(
$f
->{harness} &&
$f
->{harness}->{subtest_start}) {
my
$st
=
$self
->{+SUBTESTS}->{
$nested
+ 1} ||= {};
$st
->{event} =
$event
;
$f
->{harness_watcher}->{no_render} = 1;
return
;
}
my
@out
;
if
(
$f
->{from_tap} &&
$f
->{harness}->{subtest_end} && !(
$self
->{+SUBTESTS} &&
keys
%{
$self
->{+SUBTESTS}})) {
$f
->{harness_watcher}->{no_render} = 1;
$f
= {
%{
$f
},
harness_watcher
=> {
added_by_watcher
=> 1},
parent
=>
undef
,
trace
=>
undef
,
harness
=> {
%{
$f
->{harness} || {}},
subtest_end
=>
undef
,
},
info
=> [
@{
$f
->{info} || []},
{
details
=>
$f
->{from_tap}->{details},
tag
=>
$f
->{from_tap}->{source} ||
'STDOUT'
,
from_harness
=> 1,
}
],
};
$event
= Test2::Harness::Event->new(
stamp
=>
time
,
job_try
=>
$self
->{+TRY},
facet_data
=>
$f
);
}
push
@out
=>
$event
;
if
(
my
$sts
=
$self
->{+SUBTESTS}) {
my
@close
=
sort
{
$b
<=>
$a
}
grep
{
$_
>
$nested
}
keys
%$sts
;
for
my
$n
(
@close
) {
my
$st
=
delete
$sts
->{
$n
};
my
$se
=
$st
->{event} ||
$event
;
my
$fd
=
$se
->{facet_data};
delete
$fd
->{harness_watcher}->{no_render};
$fd
->{parent}->{hid} ||=
$n
;
$fd
->{parent}->{children} ||=
$st
->{children};
$fd
->{harness}->{closed_by} =
$event
;
$fd
->{harness}->{closed_by_eid} =
$event
->{event_id};
my
$pn
=
$n
- 1;
if
(
$st
->{event}) {
if
(
$pn
>
$self
->{+NESTED}) {
push
@{
$sts
->{
$pn
}->{children}} =>
$fd
;
}
elsif
(
$pn
==
$self
->{+NESTED}) {
$self
->subtest_process(
$fd
,
$se
);
push
@out
=>
$se
;
}
}
else
{
push
@out
=>
$se
if
$self
->{+NESTED} &&
$pn
==
$self
->{+NESTED};
}
}
}
unless
(
$is_ours
) {
my
$st
=
$self
->{+SUBTESTS}->{
$nested
} ||= {};
my
$fd
= {
%$f
};
push
@{
$st
->{children}} =>
$fd
;
return
@out
;
}
$self
->subtest_process(
$f
,
$event
);
return
@out
;
}
sub
subtest_process {
my
$self
=
shift
;
my
(
$f
,
$event
) =
@_
;
my
$closer
=
delete
$f
->{harness}->{closed_by};
$event
||= Test2::Harness::Event->new(
facet_data
=>
$f
,
job_try
=>
$self
->{+TRY});
$self
->{+NUMBERS}->{
$f
->{assert}->{number}}++
if
$f
->{assert} &&
$f
->{assert}->{number};
if
(
$f
->{parent} &&
$f
->{assert}) {
my
$name
=
$f
->{assert}->{details} //
"unnamed subtest ($f->{trace}->{frame}->[1] line $f->{trace}->{frame}->[2])"
;
my
$subwatcher
= blessed(
$self
)->new(
nested
=>
$self
->{+NESTED} + 1,
job
=>
$self
->{+JOB},
try
=>
$self
->{+TRY});
my
$id
= 1;
for
my
$sf
(@{
$f
->{parent}->{children}}) {
$sf
->{harness}->{job_id} ||=
$f
->{harness}->{job_id};
$sf
->{harness}->{run_id} ||=
$f
->{harness}->{run_id};
$sf
->{harness}->{event_id} ||=
$sf
->{about}->{uuid} ||= gen_uuid();
$subwatcher
->subtest_process(
$sf
);
}
my
@errors
=
$subwatcher
->subtest_fail_error_facet_list();
if
(
$f
->{harness}->{subtest_start}) {
push
@{
$f
->{errors}} => {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"Buffered subtest ended abruptly (missing closing brace event)"
}
unless
$closer
&&
$closer
->{facet_data}->{harness}->{subtest_end};
}
my
$fail
= 0;
if
(
@errors
) {
push
@{
$f
->{errors}} =>
@errors
;
$fail
= 1;
}
else
{
$fail
||=
$f
->{assert} && !
$f
->{assert}->{pass} && !(
$f
->{amnesty} && @{
$f
->{amnesty}});
$fail
||=
$f
->{control} && (
$f
->{control}->{halt} ||
$f
->{control}->{terminate});
$fail
||=
$f
->{errors} && first {
$_
->{fail} } @{
$f
->{errors}};
}
if
(
$fail
) {
$self
->{+_SUB_FAILURES}++;
my
$tree
=
$self
->{+FAILED_SUBTEST_TREE} //= [];
push
@$tree
=> [
$name
,
$subwatcher
->{+FAILED_SUBTEST_TREE} // []];
}
}
$self
->{+ASSERTION_COUNT}++
if
$f
->{assert};
if
(
$f
->{assert} && !
$f
->{assert}->{pass} && !(
$f
->{amnesty} && @{
$f
->{amnesty}})) {
$self
->{+_FAILURES}++;
}
if
(
$f
->{control} ||
$f
->{errors}) {
my
$err
||=
$f
->{control} && (
$f
->{control}->{halt} ||
$f
->{control}->{terminate});
$err
||=
$f
->{errors} && first {
$_
->{fail} } @{
$f
->{errors}};
$self
->{+_ERRORS}++
if
$err
;
$self
->{+HALT} =
$f
->{control}->{details} ||
'1'
if
$f
->{control} &&
$f
->{control}->{halt} && (!
$self
->{+HALT} ||
$self
->{+HALT} eq
'1'
);
}
if
(
$f
->{plan} && !
$f
->{plan}->{none}) {
$self
->{+_PLANS}++;
$self
->{+PLAN} =
$f
->{plan};
}
if
(
$f
->{harness_job_exit}) {
$self
->{+EXIT} =
$f
->{harness_job_exit}->{
exit
};
my
$file
=
$self
->file();
my
$end
=
$f
->{harness_job_end} = {
file
=>
$file
,
rel_file
=> File::Spec->abs2rel(
$file
),
abs_file
=> File::Spec->rel2abs(
$file
),
retry
=>
$f
->{harness_job_exit}->{retry},
fail
=>
$self
->fail(),
stamp
=>
$f
->{harness_job_exit}->{stamp},
};
my
$plan
=
$self
->plan;
$end
->{skip} =
$plan
->{details} ||
"No reason given"
if
$plan
&& !
$plan
->{count};
my
$times
=
$self
->
times
;
if
(
$times
&&
$times
->useful) {
$end
->{
times
} =
$times
->data_dump;
push
@{
$f
->{harness_job_fields}} =>
$times
->job_fields;
push
@{
$f
->{info}} => {
tag
=>
'TIME'
,
details
=>
$times
->summary,
table
=>
$times
->table};
}
push
@{
$f
->{errors}} =>
$self
->fail_error_facet_list;
}
return
;
}
sub
subtest_fail_error_facet_list {
my
$self
=
shift
;
return
@{
$self
->{+_SUB_INFO}}
if
$self
->{+_SUB_INFO};
my
@out
;
my
$plan
=
$self
->{+PLAN} ?
$self
->{+PLAN}->{count} :
undef
;
my
$count
=
$self
->{+ASSERTION_COUNT};
my
$numbers
=
$self
->{+NUMBERS};
my
$max
= max(
keys
%$numbers
);
if
(
$max
) {
for
my
$i
(1 ..
$max
) {
if
(!
$numbers
->{
$i
}) {
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"Assertion number $i was never seen"
};
}
elsif
(
$numbers
->{
$i
} > 1) {
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"Assertion number $i was seen more than once"
};
}
}
}
if
(!
$self
->{+_PLANS}) {
if
(
$count
) {
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"No plan was declared"
};
}
else
{
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"No plan was declared, and no assertions were made."
};
}
}
elsif
(
$self
->{+_PLANS} > 1) {
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"Too many plans were declared (Count: $self->{+_PLANS})"
};
}
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"Planned for $plan assertions, but saw $self->{+ASSERTION_COUNT}"
}
if
$plan
&&
$count
!=
$plan
;
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"Subtest failures were encountered (Count: $self->{+_SUB_FAILURES})"
}
if
$self
->{+_SUB_FAILURES};
return
@out
;
}
sub
fail_error_facet_list {
my
$self
=
shift
;
return
@{
$self
->{+_INFO}}
if
$self
->{+_INFO};
my
@out
;
my
$incomplete_subtests
=
values
%{
$self
->{+SUBTESTS}};
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"One or more incomplete subtests (Count: $incomplete_subtests)"
}
if
$incomplete_subtests
;
if
(
my
$wstat
=
$self
->{+EXIT}) {
if
(
$wstat
== -1) {
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"The harness could not get the exit code! (Code: $wstat)"
};
}
else
{
my
$e
= parse_exit(
$wstat
);
if
(
$e
->{err}) {
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"Test script returned error (Err: $e->{err})"
};
}
if
(
$e
->{sig}) {
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"Test script returned error (Signal: $e->{sig})"
};
}
}
}
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"Errors were encountered (Count: $self->{+_ERRORS})"
}
if
$self
->{+_ERRORS};
push
@out
=> {
tag
=>
'REASON'
,
fail
=> 1,
from_harness
=> 1,
details
=>
"Assertion failures were encountered (Count: $self->{+_FAILURES})"
}
if
$self
->{+_FAILURES};
push
@out
=>
$self
->subtest_fail_error_facet_list();
return
@out
;
}
1;