view release on metacpan or  search on metacpan

t/TestSuite.pm  view on Meta::CPAN

=item I<$rc>

ARRAY;
storage for FSM return;

=item I<%st>

Status table;

=item I<$bb>

B<Acme::FSM> object;
An object is reZ<>B<connect>ed;
I<$bb{queue}> is created and set to empty ARRAY.

=item I<%opts>

A hash of options, those will be passed to constructor.

=back

I<STDOUT> and I<STDERR> are backed up in scalars;
those are saved in I<$main::stdout> and I<$main::stderr>.
I<STDERR> is output with B<AFSMTS_diag()> anyway.
However, it's trimmed to first 1024 bytes
(unless I<$t::TestSuite::NO_TRIM> is TRUE)
(it's not clear yet if those are 1024 bytes or characters).

Also, there's a timeout feature.
That timeout should be protected with TODO of B<Test::More>.
I<STDERR> is dumped too.

That timeout is implemented with B<alarm>ed B<eval>.
That B<eval> protects against B<die>s too.

=cut

sub AFSMTS_wrap ( )   {
    open my $stdout_bak, q|>&|, \*STDOUT;
    open my $stderr_bak, q|>&|, \*STDERR;

    close STDOUT; open STDOUT, q|>|, \$main::stdout;
    close STDERR; open STDERR, q|>|, \$main::stderr;
    local $SIG{__DIE__} = sub          {
        alarm 0;
        close STDOUT; open STDOUT, q|>&|, $stdout_bak;
        close STDERR;
        open STDERR, q|>&|, $stderr_bak };

    do                                                               {
        no warnings qw| once |;
        $main::bb = Acme::FSM->connect( { %main::opts }, \%main::st ) };
    $main::bb->{queue} = [ ];
    my $rc = [ eval {
        local $SIG{ALRM} = sub { die qq|ALRM\n| };
        alarm 3;
        $main::rc = [ $main::bb->process ];
        alarm 0;
        1            } ];
    unless( @$rc )        {
# TODO:20121120224141:whynot: Make sure it's 1024 characters not bytes.
        $main::stderr = substr $main::stderr || '', 0, 1024   unless $NO_TRIM;
        $main::rc = [ $@ ] }
    close STDERR; open STDERR, q|>&|, $stderr_bak;
    close STDOUT; open STDOUT, q|>&|, $stdout_bak;

    AFSMTS_diag $main::stderr  }

=item B<AFSMTS_class_wrap()>

    use t::Test::Suite qw/ :wraps /;
    our( $rc, %st, $bb );
    our( $stdout, $stderr );
    AFSMTS_class_wrap @list;

Complete analogy of B<AFSMTS_wrap()> except B<process()> isn't called and
there's no timeout protection.
Also, there's I<$t::TestSuite::class_cheat>, what, if B<defined> is supposed
to be class name of B<A::F> descandant.

=cut

our $class_cheat;
sub AFSMTS_class_wrap ( @ ) {
    open my $stdout_bak, q|>&|, \*STDOUT;
    open my $stderr_bak, q|>&|, \*STDERR;

    close STDOUT; open STDOUT, q|>|, \$main::stdout;
    close STDERR; open STDERR, q|>|, \$main::stderr;
    local $SIG{__DIE__} = sub {
        close STDOUT; open STDOUT, q|>&|, $stdout_bak;
        close STDERR; open STDERR, q|>&|, $stderr_bak;
        AFSMTS_diag $main::stderr    };
    $main::bb = $class_cheat                        ?
      eval qq|${class_cheat}->connect( \@_ )| :
      Acme::FSM->connect( @_ );
    close STDERR; open STDERR, q|>&|, $stderr_bak;
    close STDOUT; open STDOUT, q|>&|, $stdout_bak;

    AFSMTS_diag $main::stderr }

=item B<AFSMTS_object_wrap()>

    use t::TestSuite qw/ :wraps /;
    our( $rc, %st, $bb );
    our( $stdout, $stderr );
    AFSMTS_object_wrap $childof_A_F, @list;

Complete analogy of B<AFSMTS_wrap()> except B<process()> isn't called and
there's no timeout protection.
It's different from B<AFSMTS_class_wrap> that it goes with
object-construction.
That object goes as a first parameter, then comes list of items to process.

=cut

sub AFSMTS_object_wrap ( $@ ) {
    my $obj = shift @_;
    open my $stdout_bak, q|>&|, \*STDOUT;
    open my $stderr_bak, q|>&|, \*STDERR;