view release on metacpan or  search on metacpan

t/TestSuite.pm  view on Meta::CPAN

use Module::Build;

use Carp qw| croak |;

=head1 NAME

TestSuite.pm - service routines of Acme::FSM build

=head1 ACCESSORIES

=over

=item I<$t::TestSuite::build>

    $t::TestSuite::build->notes( 'should_i_die' ) and die;

Provides access to current build.

=cut

our $build = Module::Build->current;

=item I<$t::TestSuite::NO_TRIM>

    $t::TestSuite::NO_TRIM = 1;

Forbids trimming I<$main::stderr>.

=cut

our $NO_TRIM;

=back

=cut

=head1 FUNCTIONS

=over

=item B<AFSMTS_diag()>

    use t::TestSuite qw/ :diag /;
    AFSMTS_diag $@

Outputs through B<Test::More::diag()>.
Void if I<STDOUT> isa not terminal, I<$ENV{QUIET}> is TRUE, I<@_> is empty, or
I<@_> consists of FALSEs.

=cut

sub AFSMTS_diag ( @ )     {
    -t STDOUT && !$ENV{QUIET} && @_ && grep $_, @_                  or return;
    Test::More::diag( @_ ) }

=item B<AFSMTS_dump()>

    use t::TestSuite qw/ :diag /;
    AFSMTS_dump $@

Dumpts through B<Data::Dumper::Dump()> (wrapped in B<Test::More::diag()>).
Void if I<STDOUT> isa not terminal, I<$ENV{QUIET}> is TRUE, I<@_> is empty, or
I<@_> consists of FALSEs.

=cut

sub AFSMTS_dump ( $ )                                  {
    -t STDOUT && !$ENV{QUIET} && @_ && $_[0]                        or return;
    require Data::Dumper;
    Test::More::diag( Data::Dumper->Dump([ shift @_ ])) }

=item B<AFSMTS_deeply()>

    use t::TestSuite qw/ :run /;
    our( $rc, $bb );
    AFSMTS_wrap;
    AFSMTS_deeply @{[[qw/ items left /], { status => 'S0' }]}, 'description';

Wrapper around B<Test::More::deeply()>.
Parameters (for B<T::M::d()>, namely) are ARRAY of two items:

=over

=item I<$main::rc>

ARRAY of items FSM has just left behind (contents of I<$main::rc>);

=item I<\%blackboard>

A blackboard snapshot after FSM has been run;
That snapshotting means:

=over

=item *

all keys of I<$main::bb>, except special I<_> key, are copied;

=item *

all keys of I<$main::bb{_}>, exccept I<fst> key, are copied.

=back

That is, everything, except filtered goes in one HASH.

=back

If B<Test::More::is_deeply()> fails then a line in a test-unit where it
happened is hinted with B<AFSMTS_diag()>.

=cut

sub AFSMTS_deeply ( \@$ )                      {
    my( $expected, $descr ) = @_;
    my $got = { };
    $got->{$_} = $main::bb->{$_}     foreach grep $_ ne q|_|, keys %$main::bb;
    $got->{$_} = $main::bb->{_}{$_}                                    foreach
      grep $_ ne q|fst|, keys %{$main::bb->{_}};
    unless( Test::More::is_deeply(
    [ $main::rc, $got ], $expected, $descr )) {
        AFSMTS_diag sprintf qq|   at %s line %i.|, ( caller )[1,2];
        AFSMTS_dump [ $main::rc ];
        AFSMTS_dump [ $got      ]              }}

=item B<AFSMTS_wrap()>

    use t::TestSuite qw/ :run /;
    our( $rc, %st, $bb, %opts );
    our( $stdout, $stderr );