my
%shared
;
sub
_initialize {
my
(
$self
,
$arg_for
) =
@_
;
$self
->SUPER::_initialize(
$arg_for
);
my
$formatter
=
$self
->formatter;
my
$context
=
$shared
{
$formatter
} ||=
$self
->_create_shared_context;
push
@{
$context
->{active} },
$self
;
return
$self
;
}
sub
_create_shared_context {
my
$self
=
shift
;
return
{
active
=> [],
tests
=> 0,
fails
=> 0,
};
}
our
$VERSION
=
'3.29'
;
sub
header {
}
sub
_clear_ruler {
my
$self
=
shift
;
$self
->formatter->_output(
"\r"
. (
' '
x WIDTH ) .
"\r"
);
}
my
$now
= 0;
my
$start
;
my
$trailer
=
'... )==='
;
my
$chop_length
= WIDTH -
length
$trailer
;
sub
_output_ruler {
my
(
$self
,
$refresh
) =
@_
;
my
$new_now
=
time
;
return
if
$new_now
==
$now
and !
$refresh
;
$now
=
$new_now
;
$start
||=
$now
;
my
$formatter
=
$self
->formatter;
return
if
$formatter
->really_quiet;
my
$context
=
$shared
{
$formatter
};
my
$ruler
=
sprintf
'===( %7d;%d '
,
$context
->{tests},
$now
-
$start
;
for
my
$active
( @{
$context
->{active} } ) {
my
$parser
=
$active
->parser;
my
$tests
=
$parser
->tests_run;
my
$planned
=
$parser
->tests_planned ||
'?'
;
$ruler
.=
sprintf
'%'
.
length
(
$planned
) .
"d/$planned "
,
$tests
;
}
chop
$ruler
;
$ruler
.=
')==='
;
if
(
length
$ruler
> WIDTH ) {
$ruler
=~ s/(.{
$chop_length
}).*/$1
$trailer
/o;
}
else
{
$ruler
.=
'='
x ( WIDTH -
length
(
$ruler
) );
}
$formatter
->_output(
"\r$ruler"
);
}
sub
result {
my
(
$self
,
$result
) =
@_
;
my
$formatter
=
$self
->formatter;
if
(
$result
->is_test ) {
my
$context
=
$shared
{
$formatter
};
$context
->{tests}++;
my
$active
=
$context
->{active};
if
(
@$active
== 1 ) {
return
$self
->SUPER::result(
$result
);
}
$self
->_output_ruler(
$self
->parser->tests_run == 1 );
}
elsif
(
$result
->is_bailout ) {
$formatter
->_failure_output(
"Bailout called. Further testing stopped: "
.
$result
->explanation
.
"\n"
);
}
}
sub
clear_for_close {
my
$self
=
shift
;
my
$formatter
=
$self
->formatter;
return
if
$formatter
->really_quiet;
my
$context
=
$shared
{
$formatter
};
if
( @{
$context
->{active} } == 1 ) {
$self
->SUPER::clear_for_close;
}
else
{
$self
->_clear_ruler;
}
}
sub
close_test {
my
$self
=
shift
;
my
$name
=
$self
->name;
my
$parser
=
$self
->parser;
my
$formatter
=
$self
->formatter;
my
$context
=
$shared
{
$formatter
};
$self
->SUPER::close_test;
my
$active
=
$context
->{active};
my
@pos
=
grep
{
$active
->[
$_
]->name eq
$name
} 0 ..
$#$active
;
die
"Can't find myself"
unless
@pos
;
splice
@$active
,
$pos
[0], 1;
if
(
@$active
> 1 ) {
$self
->_output_ruler(1);
}
elsif
(
@$active
== 1 ) {
$active
->[0]->SUPER::header;
}
else
{
delete
$shared
{
$formatter
};
}
}
1;