view release on metacpan or  search on metacpan

t/TestSuite.pm  view on Meta::CPAN

    AFSMTS_method_wrap 'some_method', @list;

Complete analogy of B<AFSMTS_wrap()> except instead of B<process()> some
requested I<$method> is B<can>ed first, than invoked with I<@list> over
I<$main::bb> in list context.
What is returned is placed in I<$main::rc> wrapped in ARRAY.
If I<$method> returned one element then ARRAY is replaced with scalar.

=cut

sub AFSMTS_method_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;
    my $method = $main::bb->can( shift @_ );
    my $rc = [ eval {
        local $SIG{ALRM} = sub { die qq|ALRM\n| };
        alarm 3;
        $main::rc  = [ $main::bb->$method( @_ ) ];
        alarm 0;
        1 } ];
    alarm 0;
    unless( @$rc )        {
        $main::stderr = substr $main::stderr // '', 0, 1024   unless $NO_TRIM;
        $main::rc = [ $@ ] }
    $main::rc  = $main::rc->[0]                            if 1 == @$main::rc;
    close STDERR; open STDERR, q|>&|, $stderr_bak;
    close STDOUT; open STDOUT, q|>&|, $stdout_bak;

    AFSMTS_diag $main::stderr  }

=item B<AFSMTS_croakson> 'actual description'

    use t::TestSuite qw/ :diag /;
    $rc = eval { die 'as expected'; 1 };
    is !$rc, 0, AFSMTS_croakson 'surprise';

That will add I<$@> (with newlines replaced with spaces) to otherwise dumb
description, like this:

    ok 1 - croaks on (surprise) (as expected at test-unit.t line 12 )

=cut

sub AFSMTS_croakson ( $ )                                     {
    my $eval_msg = $@;
    $eval_msg =~ tr{\n}{ };
    return sprintf q|croaks on (%s) (%s)|, shift @_, $eval_msg }

=item B<AFSMTS_shift()>

    our %opts;
    our @inbase = ( qw/ a b c /, undef );
    our @input = @inbase;
    $opts{source} = \&AFSMTS_shift;
    AFSMTS_wrap;

Quiet generic implementation of I<{source}> code.
Uses script globals:

=over

=item I<@inbase>

Read-only.
When I<@input> runs empty it will be reset from I<@inbase>.

=item I<@input>

Supposed items will be B<shift>ed from this array.

=back

=cut

sub AFSMTS_shift ( )         {
    do                {
        no warnings qw| once |;
        @main::input = @main::inbase                                    unless
          @main::input };
    return shift @main::input }

=item B<AFSMTS_U()>

    use t::TestSuite qw/ :switches /;
    %st = ( S0 => [qw/ S0 DONE /, \&AFSMTS_U, "", "", qw/ S0 NEXT /]);

Convinience switch.
An item is saved in I<@{$bb->{queue}>.
Returns C<undef> and consumes an item.

=cut

sub AFSMTS_U  { push @{$_[0]{queue}}, $_[1]; ( undef, undef ) }

=item B<AFSMTS_UK()>

    use t::TestSuite qw/ :switches /;
    %st = ( S0 => [qw/ S0 DONE /, \&AFSMTS_UK, "", "", qw/ S0 NEXT /]);

Convinience switch.
An item is saved in I<@{$bb->{queue}>.
Returns C<undef> and an item unaltered.

=cut

sub AFSMTS_UK { push @{$_[0]{queue}}, $_[1]; ( undef, $_[1] ) }

=item B<AFSMTS_F()>

    use t::TestSuite qw/ :switches /;
    %st = ( S0 => [qw/ S0 DONE /, \&AFSMTS_F, "", "", qw/ S0 NEXT /]);

Convinience switch.
An item is saved in I<@{$bb->{queue}>.
Returns FALSE but C<undef> and consumes an item.

=cut