Acme-FSM

 view release on metacpan or  search on metacpan

build_e7BB/Build_iu8t.pm  view on Meta::CPAN

__PACKAGE__->add_property( q|buildq85v_files| => { } );

# FIXME:202502131915:whynot: Instead of B<add_build_element()> it should piggy-back on B<ACTION_docs()>.  Too bad.
sub process_buildq85v_files        {
    my( $qrXNrk, $agxDOs ) = @_;
    $agxDOs eq q|buildq85v|        or die qq|!utOr! wrong target ($agxDOs)\n|;
# WORKAROUND:202502091853:whynot: Hard to imagine B<P::T> being missing, but that's one way to avoid to list it in I<%build_requires> (because C<buildq85v> isn't a target outside of development.
    require Pod::Text         or die qq|!wmvU! [require](Pod::Text) failed\n|;
# NOTE:202502091918:whynot: v3.17
    my $qrSl5y = Pod::Text->new(
      alt => !0, errors => q|stderr|, sentence => !0 );
    my @lmGCWI;
    while( my( $hprHQ0, $hqVg4r ) = each %{ $qrXNrk->buildq85v_files } ) {
        my $hkTrsQ = ( stat $hprHQ0 )[9];
        defined $hkTrsQ               or die qq|!0lnO! [stat]($hprHQ0): $!\n|;
        my $hkVGdJ = -e $hqVg4r ? ( stat $hqVg4r )[9] : 0;
        defined $hkVGdJ               or die qq|!R6ZO! [stat]($hqVg4r): $!\n|;
        $hkTrsQ < $hkVGdJ and next;
        open my $hpNrEp, q|<|, $hprHQ0                                  or die
          qq|!nUAe! [open]($hprHQ0): $!\n|;
        open my $hqrXZZ, q|>|, $hqVg4r                                  or die

t/TestSuite.pm  view on Meta::CPAN

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

t/TestSuite.pm  view on Meta::CPAN

    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 );

    AFSMTS_wrap;
    AFSMTS_deeply @{[ ]}, 'again!';

    TODO: {
        local TODO = 'oops, not yet';
        AFSMTS_wrap;
        isnt $rc, "ALRM\n", 'success!';
    }

t/TestSuite.pm  view on Meta::CPAN

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;

    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 = $obj->connect( @_ );
    close STDERR; open STDERR, q|>&|, $stderr_bak;
    close STDOUT; open STDOUT, q|>&|, $stdout_bak;

    AFSMTS_diag $main::stderr }

=item B<AFSMTS_method_wrap()>

    use t::TestSuite qw/ :wraps /;
    our( $rc, %st, $bb );
    our( $stdout, $stderr );
    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:

t/action/next.t  view on Meta::CPAN

use warnings;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );

use t::TestSuite qw| :run :diag |;
use Test::More tests => 41;

use Acme::FSM;

our( %st, $rc, %opts, $stderr );
our @inbase = (                         undef,
                              q|DEATH|, undef,
  qw|                   Famine Satan |, undef,
  qw|                 ADAM Ligur God |, undef,
  qw| Shadwell Brian War Wensleydale |, undef );
our @input = @inbase;
$opts{source} = \&AFSMTS_shift;
my $tag;

my %common =

t/action/same.t  view on Meta::CPAN

package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );

use t::TestSuite qw| :run :diag |;
use Test::More;

plan tests => 41;

use Acme::FSM;

our( %st, $rc, %opts, $stderr );
our @inbase = (                         undef,
                           q|Kraljevo|, undef,
  qw|         Seattle Charlottesvill |, undef,
  qw|    Malaysia Marseille LasVegas |, undef,
  qw| Purdue Women Pittsburgh Sonoma |, undef );
our @input = @inbase;
$opts{source} = \&AFSMTS_shift;
my $tag;

my %common =

t/action/tstl.t  view on Meta::CPAN

package main;
use version 0.77; our $VERSION = version->declare( v2.2.5 );

use t::TestSuite qw| :run :diag |;
use Test::More;

plan tests => 41;

use Acme::FSM;

our( %st, $rc, %opts, $stderr );
our @inbase = (                       undef,
                            q|Adams|, undef,
  qw|              Roosevelt Hayes |, undef,
  qw|   Jefferson Harrison Johnson |, undef,
  qw| Buchanan Bush Lincoln Carter |, undef );
our @input = @inbase;
$opts{source} = \&AFSMTS_shift;
my $tag;

my %common =

t/base/action.t  view on Meta::CPAN

use parent q|Acme::FSM|;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.1 );

use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 14;

use Acme::FSM;

our( $bb, $rc, $stderr );
my $method = q|action|;

my( $old, $new ) = qw| VOID champagne |;
AFSMTS_class_wrap { diag_level => 10 };
isa_ok $bb, q|Acme::FSM|, q|constructed object|;
is $bb->{_}{action}, $old, qq|initial {action} isa ($old)|;

my $tag = q|no args,|;
AFSMTS_method_wrap $method;
is $rc, $old, qq|$tag {action} is returned|;
is $bb->{_}{action}, $old, qq|$tag correct|;

$tag = q|one arg,|;
AFSMTS_method_wrap $method, $new;
is $bb->{_}{action}, $new, qq|$tag new {action} is set|;
is $rc, $old, qq|$tag old {action} is returned|;
like $stderr, qr<(?m)^\Q[action]: changing action: ($old) ($new)>,
  qq|$tag noted|;

$tag = q|other arg,|;
( $old, $new ) = ( $new, q|ale| );
AFSMTS_method_wrap $method, $new;
is $bb->{_}{action}, $new, qq|$tag new {action} is set again|;
is $rc, $old, qq|$tag old {action} is returned again|;
like $stderr, qr<(?m)^\Q[action]: changing action: ($old) ($new)>,
  qq|$tag noted|;

$tag = q|two args,|;
AFSMTS_method_wrap $method, qw| rum porter |;
is $bb->{_}{action}, $new, qq|$tag old {action} stays|;
ok !defined $rc, qq|$tag ((undef)) is returned|;
like $stderr, qr<(?m)^\Q[action]: too many args (2) >, qq|$tag noted|;
AFSMTS_method_wrap $method;
is $rc, $new, qq|$tag {action} stays|;

# vim: set filetype=perl

t/base/carp.t  view on Meta::CPAN

use parent q|Acme::FSM|;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.2 );

use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 6;

use Acme::FSM;

our( $bb, $stderr );
my $method = q|carp|;

AFSMTS_class_wrap { diag_level => 10 };
isa_ok $bb, q|Acme::FSM|, q|constructed object|;

my $tag = q|no args,|;
AFSMTS_method_wrap $method;
unlike $stderr, qr{(?m)^Use of uninitialized value\V+Acme/FSM\V+$},
  qq|$tag no UOUV warning|;
like $stderr, qr{(?m)^\[\(eval\)\]:\h+at t/TestSuite\.pm\V+$},
  qq|$tag noted|;

$tag = q|one arg,|;
AFSMTS_method_wrap $method, q|deer|;
like $stderr, qr{(?m)\V+: deer at \V+}, qq|$tag noted|;

$tag = q|two args,|;
AFSMTS_method_wrap $method, qw| moose alces_alces |;
like $stderr, qr{(?m)^\V+: moosealces_alces at \V+$}, qq|$tag noted|;

$tag = q|trimmed {diag_level}|;
AFSMTS_object_wrap $bb, { diag_level => 0 };
AFSMTS_method_wrap $method;
is $stderr, '', qq|$tag obeyed|;

# vim: set filetype=perl

t/base/connect.t  view on Meta::CPAN

use parent q|Acme::FSM|;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.1 );

use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 54;

use Acme::FSM;

our( $bb, $bback, $stderr );

$bb = eval { AFSMTS_class_wrap; 1 };
ok !$bb && $@ =~ m<{options} HASH is required>,
  AFSMTS_croakson q|class, no {options}|;

my %common =
( fst        => {      },
  state      => q|START|,
  action     =>  q|VOID|,
  diag_level =>       10,
  namespace  =>    undef,
  source     =>    undef,
  dumper     =>    undef );

my $tag = q|class, empty {options},|;
AFSMTS_class_wrap { };
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, diag_level => 1 }, qq|$tag init done|;
like $stderr, qr<(?m)^\Q[connect]: FST has no {START} state>,
  qq|$tag no {START} noted|;
like $stderr, qr<(?m)^\Q[connect]: FST has no {STOP} state>,
  qq|$tag no {STOP} noted|;

$bback = $bb;
undef $bb;

$bb = eval { AFSMTS_object_wrap $bback; 1 };
ok !$bb && $@ =~ m<{options} HASH is required>,
  AFSMTS_croakson q|object, no {options}|;

$tag = q|object, empty {options},|;
AFSMTS_object_wrap $bback, { };
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, diag_level => 1 }, qq|$tag init done|;
like $stderr, qr<(?m)^\Q[connect]: FST has no {START} state>,
  qq|$tag no {START} noted|;
like $stderr, qr<(?m)^\Q[connect]: FST has no {STOP} state>,
  qq|$tag no {STOP} noted|;
is_deeply
[ $bb->{_}{fst}, $bb->{_} ne $bback->{_} ], [ $bback->{_}{fst}, !0 ],
  qq|$tag {fst} check|;

$tag = q|class, minimal FST explicitly in {@_},|;
AFSMTS_class_wrap { diag_level => 10 }, qw| START splat STOP tic_tac_toe |;
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, fst => {qw| START splat STOP tic_tac_toe |}},
  qq|$tag init done|;
like $stderr, qr<(?m)^\Q[connect]: clean init with (2) >,
  qq|$tag items in FST noted|;

$bback = $bb;
$tag = q|object, minimal FST explicity in {@_},|;
AFSMTS_object_wrap $bback, { }, qw| START hash_mark STOP pound_sign |;
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, fst => {qw| START splat STOP tic_tac_toe |}},
  qq|$tag init done|;
is_deeply
[ $bb->{_}{fst}, $bb->{_} ne $bback->{_} ], [ $bback->{_}{fst}, !0 ],
  qq|$tag {fst} check|;
like $stderr, qr<(?m)^\Q[connect]: stealing (2) >,
  qq|$tag items in FST noted|;
like $stderr, qr<(?m)^\Q[connect]: ignoring (4) >,
  qq|$tag items in trailer noted|;

$tag = q|class, minimal FST in HASH,|;
my $fsta = {qw| START flash STOP thump |};
AFSMTS_class_wrap { diag_level => 10 }, $fsta;
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, fst => { %$fsta }}, qq|$tag init done|;
is $bb->{_}{fst}, $fsta, qq|$tag {fst} isa prepared HASH|;
like $stderr, qr<(?m)^\Q[connect]: clean init with (2) >,
  qq|$tag items in FST noted|;

$bback = $bb;
$tag = q|object, minimal FST in HASH,|;
my $fstb = {qw| START thud STOP sharp |};
AFSMTS_object_wrap $bback, { }, $fstb;
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, fst => { %$fsta }}, qq|$tag init done|;
is_deeply
[ $bb->{_}{fst}, $bb->{_} ne $bback->{_}, $bb->{_}{fst} ],
[                           $bback->{_}{fst}, !0, $fsta ],
  qq|$tag {fst} check|;
like $stderr, qr<(?m)^\Q[connect]: stealing (2) >,
  qq|$tag items in FST noted|;
like $stderr, qr<(?m)^\Q[connect]: ignoring (2) >,
  qq|$tag items in trailer noted|;

$tag = q|class, minimal FST in HASH, minimal trailer,|;
$fsta = {qw| START mesh STOP crosshatch |};
AFSMTS_class_wrap { diag_level => 10 }, $fsta, hex => q|octalthorpe|;
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, fst => { %$fsta }}, qq|$tag init done|;
is $bb->{_}{fst}, $fsta, qq|$tag {fst} isa prepared HASH|;
like $stderr, qr<(?m)^\Q[connect]: clean init with (2) >,
  qq|$tag items in FST noted|;
like $stderr, qr<(?m)^\Q[connect]: ignoring (2) >,
  qq|$tag items in trailer noted|;

$bback = $bb;
$tag = q|object, minimal FST in HASH, minimal trailer,|;
$fstb = {qw| START octothorn STOP crunch |};
AFSMTS_object_wrap $bback, { }, $fstb, noughts_and_crosses => q|widget_mark|;
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, fst => { %$fsta }}, qq|$tag init done|;
is $bb->{_}{fst}, $fsta, qq|$tag {fst} isa prepared HASH|;
like $stderr, qr<(?m)^\Q[connect]: stealing (2) >,
  qq|$tag items in FST noted|;
like $stderr, qr<(?m)^\Q[connect]: ignoring (2) >,
  qq|$tag items in traler noted|;

$t::TestSuite::class_cheat = q|t::TestSuite::FSM|;
$tag = q|just checking,|;
$fsta = {qw| START pig_pen STOP comment_sign |};
AFSMTS_class_wrap { }, $fsta;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag processed|;

$bback = $bb;
$tag = q|object, inheritance,|;
AFSMTS_object_wrap $bback, { };
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag processed|;
undef $t::TestSuite::class_cheat;

$tag = q|class, unknown {options},|;
AFSMTS_class_wrap { diag_level => 10, noughts_and_crosses => q|octothorpe| };
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common }, qq|$tag init done|;
like $stderr, qr<(?m)^\Q[connect]: (noughts_and_crosses): unknown option>,
  qq|$tag noted|;

$bback = $bb;
$tag = q|object, unknown {options},|;
AFSMTS_object_wrap $bback, { hex => q|gate| };
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common }, qq|$tag init done|;
like $stderr, qr<(?m)^\Q[connect]: (hex): unknown option>, qq|$tag noted|;

$tag = q|class, {options}{namespace},|;
AFSMTS_class_wrap { diag_level => 10, namespace => q|gate| };
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, namespace => q|gate| },
  qq|$tag {namespace} accepted|;

$bback = $bb;
$tag = q|object, {options}{namespace}, get from source,|;
AFSMTS_object_wrap $bback, { };

t/base/diag.t  view on Meta::CPAN

use warnings;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.4 );

use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 25;

use Acme::FSM;

our( $bb, $stderr );
my $method = q|diag|;

AFSMTS_class_wrap { diag_level => 10 };
isa_ok $bb, q|Acme::FSM|, q|constructed object|;

my $tag = q|no args,|;
AFSMTS_method_wrap $method;
like $stderr, qr{(?m)^Use of uninitialized value in numeric\V+Acme/FSM\V+$},
  qq|$tag UOUV in level check|;
like $stderr, qr{(?m)^Use of uninitialized value in sprintf\V+Acme/FSM\V+$},
  qq|$tag UOUV in sprintf|;
like $stderr, qr{(?m)^\[\(eval\)\]: $}, qq|$tag noted|;

$tag = q|limit isn't numeric,|;
AFSMTS_method_wrap $method, q|northwest|;
like $stderr, qr{(?m)"northwest" isn't numeric in numeric\V+Acme/FSM\V+$},
  qq|$tag ININ in level check|;
like $stderr, qr{(?m)^Use of uninitialized value in sprintf\V+Acme/FSM\V+$},
  qq|$tag UOUV in sprintf|;
like $stderr, qr{(?m)^\[\(eval\)\]: $}, qq|$tag noted|;

$tag = q|no format,|;
AFSMTS_method_wrap $method, 9;
unlike $stderr, qr{(?m)\V+ in numeric\V+Acme/FSM\V+$},
  qq|$tag no ININ in level check|;
like $stderr, qr{(?m)^Use of uninitialized value in sprintf\V+Acme/FSM\V+$},
  qq|$tag UOUV in sprintf|;
like $stderr, qr{(?m)^\[\(eval\)\]: $}, qq|$tag noted|;

$tag = q|format, no conversion,|;
AFSMTS_method_wrap $method, 9, q|south|;
unlike $stderr, qr{(?m)\V+Acme/FSM\V+$}, qq|$tag no warnings|;
like $stderr, qr{(?m)^\[\(eval\)\]: south$}, qq|$tag noted|;

$tag = q|format, conversion, no paramter,|;
AFSMTS_method_wrap $method, 9, q|%s|;
like $stderr, qr{(?m)^Missing argument in printf\V+Acme/FSM\V+$},
  qq|$tag MAI printf|;
like $stderr, qr{(?m)^\[\(eval\)\]: $}, qq|$tag noted|;

$tag = q|format, conversion, paramter,|;
AFSMTS_method_wrap $method, 9, q|%s|, q|southwest|;
unlike $stderr, qr{(?m)\V+Acme/FSM\V+$}, qq|$tag no warnings|;
like $stderr, qr{(?m)^\[\(eval\)\]: southwest$}, qq|$tag noted|;

$tag = q|format, conversion, extra paramter,|;
AFSMTS_method_wrap $method, 9, q|%s|, qw| east west |;
TODO: {
    local $TODO = q|not enabling C<no warnings "redundant">|;
    like $stderr, qr{(?m)\V+Acme/FSM\V+$}, qq|$tag no warnings| }
like $stderr, qr{(?m)^\[\(eval\)\]: east$}, qq|$tag noted|;

my @in = qw| Narrator Tinky_Winky Baby_Sun Po Trumpets Noo_Noo Dipsy |;
my @data =
([qw|                                                Narrator |],
 [qw|                                    Narrator Tinky_Winky |],
 [qw|                           Narrator Tinky_Winky Baby_Sun |],
 [qw|                        Narrator Tinky_Winky Baby_Sun Po |],
 [qw|               Narrator Tinky_Winky Baby_Sun Po Trumpets |],
 [qw|       Narrator Tinky_Winky Baby_Sun Po Trumpets Noo_Noo |],
 [qw| Narrator Tinky_Winky Baby_Sun Po Trumpets Noo_Noo Dipsy |] );

foreach my $level ( 0 .. 6 )                                             {
    my @out;
    AFSMTS_object_wrap $bb, { diag_level => $level };
    foreach my $diag ( 0 .. 6 ) {
        AFSMTS_method_wrap $method, $diag, $in[$diag];
        push @out, $in[$diag]                                               if
          $stderr                }
    is_deeply [ @out ], $data[$level], qq|respects {diag_level} ($level)| }

# vim: set filetype=perl

t/base/fst.t  view on Meta::CPAN

use warnings;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );

use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 43;

use Acme::FSM;

our( $bb, $rc, $stderr );
my $method = q|fst|;
my( $fste, $fsto ) = qw| lobster beans |;
my( $old, $new, $deep, $late ) = qw| entwistle barry boeblich fazzo |;
my $tag;

AFSMTS_class_wrap { diag_level => 10 };
isa_ok $bb, q|Acme::FSM|, q|constructed object|;
ok !keys %{$bb->{_}{fst}}, qq|initial {fst} isa empty|;

$tag = q|no args, no fste,|;
AFSMTS_method_wrap $method;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 0, undef ],
  qq|$tag queried|;
like $stderr, qr<(?m)^\Q[fst]: no args >, qq|$tag noted|;

$tag = q|one arg, fste isa unset,|;
AFSMTS_method_wrap $method, $fste;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 0, undef ],
  qq|$tag queried|;
like $stderr, qr<(?m)^\Q[fst]: ($fste): no such {fst} record>, qq|$tag noted|;

$tag = q|two args (SCALAR), fste isa unset,|;
AFSMTS_method_wrap $method, $fste => $old;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 0, undef ],
  qq|$tag queried|;
like $stderr, qr<(?m)^\Q[fst]: ($fste): no such {fst} record>, qq|$tag noted|;

$tag = q|three args, fste isa unset,|;
AFSMTS_method_wrap $method, $fste => $old => $deep;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 0, undef ],
  qq|$tag queried|;
like $stderr, qr<(?m)^\Q[fst]: ($fste): no such {fst} record>, qq|$tag noted|;

$tag = q|two args (HASH), fste isa unset,|;
my $elder = { $old => $late };
AFSMTS_method_wrap $method, $fste => $elder;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 1, undef ],
  qq|$tag queried|;
ok exists $bb->{_}{fst}{$fste}, qq|$tag {fst} is indeed updated|;
is_deeply $bb->{_}{fst}{$fste}, { %$elder },
  qq|$tag just created entry is correct|;
isnt $bb->{_}{fst}{$fste}, $elder, qq|$tag just created entry is copied|;
like $stderr, qr<(?m)^\Q[fst]: creating {$fste} >, qq|$tag noted|;

$tag = q|one arg, fste is set,|;
AFSMTS_method_wrap $method, $fste;
is_deeply
[ scalar keys %{$bb->{_}{fst}}, qq|$rc| ], [ 1, qq|$bb->{_}{fst}{$fste}| ],
  qq|$tag queried|;
is_deeply $rc, $elder, qq|$tag {fst} entry is returned|;

$tag = q|two args (SCALAR), fste is set, known key,|;
AFSMTS_method_wrap $method, $fste => $old;

t/base/fst.t  view on Meta::CPAN

is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 1, undef ],
  qq|$tag queried|;
is_deeply $bb->{_}{fst}{$fste}, $elder, qq|$tag {fst} entry stays intact|;

$tag = q|three args, fste is set, known key,|;
$elder->{$old} = $deep;
AFSMTS_method_wrap $method, $fste => $old => $deep;
is_deeply [ scalar keys %{$bb->{_}{fst}}, qq|$rc| ], [ 1, qq|$late| ],
  qq|$tag queried|;
is_deeply $bb->{_}{fst}{$fste}, $elder, qq|$tag {fst} entry is updated|;
like $stderr, qr<(?m)^\Q[fst]: updating {$fste}{$old} >, qq|$tag noted|;
AFSMTS_method_wrap $method, $fste;
is_deeply $rc, $elder, qq|$tag indeed it is|;

$tag = q|three args, fste is set, unknown key,|;
$elder->{$new} = $deep = q|fauchard|;
AFSMTS_method_wrap $method, $fste => $new => $deep;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 1, undef ],
  qq|$tag queried|;
is_deeply $bb->{_}{fst}{$fste}, $elder, qq|$tag {fst} entry is updated|;
like $stderr, qr<(?m)^\Q[fst]: creating {$fste}{$new} >, qq|$tag noted|;
AFSMTS_method_wrap $method, $fste;
is_deeply $rc, $elder, qq|$tag indeed it is|;

$tag = q|three args, fste is set, duplicate value,|;
$elder->{$new} = $late;
AFSMTS_method_wrap $method, $fste => $new => $late;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 1, $deep ],
  qq|$tag queried|;
is_deeply $bb->{_}{fst}{$fste}, $elder, qq|$tag {fst} entry is updated|;
like $stderr, qr<(?m)^\Q[fst]: updating {$fste}{$new} >, qq|$tag noted|;
AFSMTS_method_wrap $method, $fste;
is_deeply $rc, $elder, qq|$tag indeed it is|;

$tag = q|two args (HASH), other fste isa unset,|;
( $old, $late ) = qw| billy lazar |;
my $youngster = { $old => $late };
AFSMTS_method_wrap $method, $fsto => $youngster;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 2, undef ],
  qq|$tag queried|;
ok exists $bb->{_}{fst}{$fsto}, qq|$tag {fst} is indeed updated|;
is_deeply $bb->{_}{fst}{$fsto}, { %$youngster },
  qq|$tag just created entry is correct|;
isnt $bb->{_}{fst}{$fsto}, $youngster, qq|$tag just created entry is copied|;
like $stderr, qr<(?m)^\Q[fst]: creating {$fsto} >, qq|$tag noted|;
AFSMTS_method_wrap $method, $fste;
is_deeply $rc, $elder, qq|$tag other {fst} isn't affected|;

$tag = q|four args,|;
AFSMTS_method_wrap $method, qw| beans billy lazar contango |;
like $stderr, qr<(?m)^\Q[fst]: too many args (4)>, qq|$tag noted|;
is scalar keys %{$bb->{_}{fst}}, 2, qq|$tag {fst} is intact|;
AFSMTS_method_wrap $method, $fste;
is_deeply $rc, $elder, qq|$tag first {fst} isn't affected|;
AFSMTS_method_wrap $method, $fsto;
is_deeply $rc, $youngster, qq|$tag second {fst} isn't affected|;

# vim: set filetype=perl

t/base/query.t  view on Meta::CPAN

    shift @main::flags }

package main;
use version 0.77; our $VERSION = version->declare( v2.3.2 );

use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 45;

use Acme::FSM;

our( $bb, $rc, $stderr );
our %st    = (      );
my $method = q|query|;

our @flags =
qw| The_Night_We_Died                Zaia
    Muh                            Ka_III
    Zombies              De_Zeuhl_Undazir
    Eliphas_Levi        Maneh_Fur_Da_Zess
    Troller_Tanz           Ek_Sun_Da_Zess
    C_est_la_Vie_Qui_les_A_Menes_La  Nono

t/base/query.t  view on Meta::CPAN

$tag = q|{havoc} isa (Acme::FSM),|;
AFSMTS_method_wrap $method, $bb, $mf;
like $@, qr.\Q {havoc} isa (Acme::FSM)., AFSMTS_croakson $tag;

$tag = q|{havoc} isa (CODE), {namespace} unset,|;
AFSMTS_method_wrap $method, \&t::TestSuite::FSM::shift_shift, $mf;
is_deeply
[ $bb->{bull}, exists $bb->{shambles}, $rc ],
[        q|The_Night_We_Died|, '', q|Zaia| ],
  qq|$tag queried|;
like $stderr, qr.(?m)\Q[(eval)]: {havoc} isa (CODE).,
  qq|$tag noted|;

$tag = q|{havoc} isa (CODE), {namespace} unset, argument isa set,|;
AFSMTS_method_wrap $method,
  \&t::TestSuite::FSM::shift_shift, $mf, q|Fur_Dihhel_Kobaia|;
is_deeply
[@$bb{qw| bull shambles |}, $rc ], [qw| Muh Fur_Dihhel_Kobaia Ka_III |],
  qq|$tag queried|;
like $stderr, qr.(?m)\Q[(eval)]: {havoc} isa (CODE).,
  qq|$tag noted|;

$tag = q|{havoc} isa (CODE), {namespace} isa set,|;
AFSMTS_class_wrap { %plug, namespace => q|swill| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, \&t::TestSuite::FSM::shift_shift, $mf;
is_deeply
[ $bb->{bull}, exists $bb->{shambles}, $rc ],
[      q|Zombies|, '', q|De_Zeuhl_Undazir| ],
  qq|$tag queried|;
like $stderr, qr.(?m)\Q[(eval)]: {havoc} isa (CODE).,
  qq|$tag noted|;

$tag = q|{havoc} isa (CODE), {namespace} isa set, argument isa set,|;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, \&t::TestSuite::FSM::shift_shift, $mf, q|Hhai|;
is_deeply
[@$bb{qw|           bull shambles |}, $rc ],
[qw| Eliphas_Levi Hhai Maneh_Fur_Da_Zess |],
  qq|$tag queried|;
like $stderr, qr.(?m)\Q[(eval)]: {havoc} isa (CODE).,
  qq|$tag noted|;

$tag = q|{havoc} isa (), {namespace} !isa defined,|;
AFSMTS_class_wrap { %plug }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|junk|, $mf;
like $@, qr.\Q {namespace} !isa defined., AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[(eval)]: {havoc} isa ()., qq|$tag noted|;

$tag = q|{havoc} !isa defined method, {namespace} eq (),|;
$t::TestSuite::class_cheat = q|t::TestSuite::FSM|;
AFSMTS_class_wrap { %plug, namespace => '' }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|tfihs_tfihs|, $mf;
like $@, qr.\Q <t::TestSuite::FSM> can't [tfihs_tfihs] method .,
  AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[(eval)]: defaulting {havoc} to \E\x24self.,
  qq|$tag defaulting noted|;
like $stderr, qr.(?m)\Q[(eval)]: {namespace} isa (t::TestSuite::FSM).,
  qq|$tag defaulted noted|;

$tag = q|{havoc} isa defined method, {namespace} eq (),|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf;
is_deeply
[ $bb->{bull}, exists $bb->{shambles}, $rc ],
[   q|Troller_Tanz|, '', q|Ek_Sun_Da_Zess| ],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[(eval)]: going for <t::TestSuite::FSM>->[shift_shift].,
  qq|$tag noted|;

$tag = q|{havoc} isa defined method, {namespace} eq (), argument is set,|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf, q|Coltrane_Sundia|;
is_deeply
[@$bb{qw|                            bull shambles |}, $rc ],
[qw| C_est_la_Vie_Qui_les_A_Menes_La Coltrane_Sundia Nono |],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[(eval)]: going for <t::TestSuite::FSM>->[shift_shift].,
  qq|$tag noted|;

$tag =
  q|{havoc} !isa defined method, {namespace} eq (t::TestSuite::havoc),|;
my $havoc = t::TestSuite::havoc->new;
undef $t::TestSuite::class_cheat;
AFSMTS_class_wrap { %plug, namespace => $havoc }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|tfihs_tfihs|, $mf;
like $@, qr.\Q <t::TestSuite::havoc> can't [tfihs_tfihs] method .,
  AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[(eval)]: defaulting {havoc} to \E\x24self.,
  qq|$tag no defaulting|;
like $stderr, qr.(?m)\Q[(eval)]: {namespace} isa (t::TestSuite::havoc).,
  qq|$tag {namespace} noted|;

$tag = q|{havoc} isa defined method, {namespace} eq (t::TestSuite::havoc),|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf;
is_deeply
[        $havoc->{mess}, exists $bb->{bull}, $rc ],
[ q|Do_The_Music|, '', q|Da_Zeuhl_Worts_Mekanik| ],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[(eval)]: going for <t::TestSuite::havoc>->[shift_shift].,
  qq|$tag noted|;

$tag =
 q|{havoc} isa defined method, {namespace} eq (t::TestSuite::havoc), | .
 q|argument is set,|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf, q|Kohntark|;
is_deeply [@$havoc{qw| mess slops |}, $rc ], [qw| Thaud Kohntark Wainsaht |],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[(eval)]: going for <t::TestSuite::havoc>->[shift_shift].,
  qq|$tag noted|;

$tag =
  q|{havoc} !isa defined subroutine, {namespace} eq (t::TestSuite::havoc),|;
AFSMTS_class_wrap { %plug, namespace => q|t::TestSuite::havoc| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|tfihs_tfihs|, $mf;
like $@,
  qr.(?m)\Q[(eval)]: <t::TestSuite::havoc> package can't [tfihs_tfihs].,
  AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[(eval)]: defaulting {havoc} to \E\x24self.,
  qq|$tag no defaulting|;
like $stderr, qr.(?m)\Q[(eval)]: {namespace} isa ().,
  qq|$tag {namespace} isa scalar|;

$tag =
  q|{havoc} isa defined subroutine, {namespace} eq (t::TestSuite::havoc),|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf;
is_deeply
[             $bb->{mess}, exists $bb->{bull}, $rc ],
[ q|The_Last_Seven_Minutes|, '', q|Nebehr_Gudahtt| ],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[(eval)]: going for <t::TestSuite::havoc>::[shift_shift].,
  qq|$tag noted|;

$tag =
  q|{havoc} isa defined subroutine, {namespace} eq (t::TestSuite::havoc), | .
  q|argument is set,|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf, q|Ka_I|;
is_deeply [@$bb{qw| mess slops |}, $rc ], [qw| Udu_Wudu Ka_I Kohntarkosz |],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[(eval)]: going for <t::TestSuite::havoc>::[shift_shift].,
  qq|$tag noted|;

$tag = q|{havoc} returns empty,|;
AFSMTS_class_wrap { }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, sub { }, $mf;
is_deeply $rc, [ ], qq|$tag queried|;

$tag = q|{havoc} returns one item, item isa scalar|;

t/base/query_dumper.t  view on Meta::CPAN

    shift @main::flags }

package main;
use version 0.77; our $VERSION = version->declare( v2.3.2 );

use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 65;

use Acme::FSM;

our( %st, $bb, $rc, $stderr );
our @flags =
qw| Orcrist           Brinning
    Nothung           Gurthang
    Caliburn             Mimun 
    Durandal            Graban
    Ekkisax         Noralltach
    Claidheamh_Solius Samsamha
    Baptism            Galatyn
    Murgleis      Haute_Claire
    Waske             Courtain

t/base/query_dumper.t  view on Meta::CPAN

like $@, qr.\Q {dumper} isa (Acme::FSM)., AFSMTS_croakson $tag;

$tag = q|{dumper} isa (CODE), {namespace} unset,|;
AFSMTS_class_wrap { %plug, dumper => \&t::TestSuite::FSM::shift_shift }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{matrixone}, exists $bb->{CSSC}, $rc ],
[               q|Orcrist|, '', q|Brinning| ],
  qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_dumper]: {dumper} isa (CODE)., qq|$tag noted|;

$tag = q|{dumper} isa (CODE), {namespace} unset, argument isa set,|;
AFSMTS_class_wrap { %plug, dumper => \&t::TestSuite::FSM::shift_shift }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Dyrnwyn|;
is_deeply
[@$bb{qw| matrixone CSSC |}, $rc ], [qw| Nothung Dyrnwyn Gurthang |],
  qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_dumper]: {dumper} isa (CODE)., qq|$tag noted|;

$tag = q|{dumper} isa (CODE), {namespace} isa set,|;
AFSMTS_class_wrap
{ %plug,
  namespace =>                    q|Subversion|,
  dumper    => \&t::TestSuite::FSM::shift_shift },
  \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{matrixone}, exists $bb->{CSSC}, $rc ], [ q|Caliburn|, '', q|Mimun| ],
  qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_dumper]: {dumper} isa (CODE)., qq|$tag noted|;

$tag = q|{dumper} isa (CODE), {namespace} isa set, argument isa set,|;
AFSMTS_class_wrap
{ %plug, namespace => q|vesta|, dumper => \&t::TestSuite::FSM::shift_shift },
  \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Merveilleuse|;
is_deeply
[@$bb{qw| matrixone CSSC |}, $rc ], [qw| Durandal Merveilleuse Graban |],
  qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_dumper]: {dumper} isa (CODE)., qq|$tag noted|;

$tag = q|{dumper} isa (), {namespace} !isa defined,|;
AFSMTS_class_wrap { %plug, dumper => q|projector| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q {namespace} !isa defined., AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[query_dumper]: {dumper} isa ()., qq|$tag noted|;

$tag = q|{dumper} !isa defined method, {namespace} eq (),|;
$t::TestSuite::class_cheat = q|t::TestSuite::FSM|;
AFSMTS_class_wrap { %plug, namespace => '', dumper => q|tfihs_tfihs| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q <t::TestSuite::FSM> can't [tfihs_tfihs] method .,
  AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[query_dumper]: defaulting {dumper} to \E\x24self.,
  qq|$tag defaulting noted|;
like $stderr, qr.(?m)\Q[query_dumper]: {namespace} isa (t::TestSuite::FSM).,
  qq|$tag defaulted noted|;

$tag = q|{dumper} isa defined method, {namespace} eq (),|;
AFSMTS_class_wrap { %plug, namespace => '', dumper => q|shift_shift| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{matrixone}, exists $bb->{CSSC}, $rc ],
[             q|Ekkisax|, '', q|Noralltach| ],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[query_dumper]: going for <t::TestSuite::FSM>->[shift_shift].,
  qq|$tag noted|;

$tag = q|{dumper} isa defined method, {namespace} eq (), argument is set,|;
AFSMTS_class_wrap { %plug, namespace => '', dumper => q|shift_shift| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Quern_biter|;
is_deeply
[            @$bb{qw| matrixone CSSC |}, $rc ],
[qw| Claidheamh_Solius Quern_biter Samsamha |],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[query_dumper]: going for <t::TestSuite::FSM>->[shift_shift].,
  qq|$tag noted|;

$tag =
  q|{dumper} !isa defined method, {namespace} eq (t::TestSuite::dumper),|;
my $dumper = t::TestSuite::dumper->new;
undef $t::TestSuite::class_cheat;
AFSMTS_class_wrap
{ %plug, namespace => $dumper, dumper => q|tfihs_tfihs| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q <t::TestSuite::dumper> can't [tfihs_tfihs] method .,
  AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[query_dumper]: defaulting {dumper} to \E\x24self.,
  qq|$tag no defaulting|;
like $stderr,
  qr.(?m)\Q[query_dumper]: {namespace} isa (t::TestSuite::dumper).,
  qq|$tag {namespace} noted|;

$tag = q|{dumper} isa defined method, {namespace} eq (t::TestSuite::dumper),|;
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => $dumper, dumper => q|shift_shift| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $dumper->{aegis}, exists $bb->{matrixone}, $rc ],
[                     q|Baptism|, '', q|Galatyn| ],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[query_dumper]: going for <t::TestSuite::dumper>->[shift_shift].,
  qq|$tag noted|;

$tag =
  q|{dumper} isa defined method, {namespace} eq (t::TestSuite::dumper), | .
  q|argument is set,|;
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => $dumper, dumper => q|shift_shift| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Sting|;
is_deeply
[@$dumper{qw| aegis slash_briefcase |}, $rc ],
[qw|           Murgleis Sting Haute_Claire |],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[query_dumper]: going for <t::TestSuite::dumper>->[shift_shift].,
  qq|$tag noted|;

$tag =
  q|{dumper} !isa defined subroutine, {namespace} eq (t::TestSuite::dumper),|;
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::dumper|, dumper => q|tfihs_tfihs| },
  \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@,
  qr.(?x)\[query_dumper\]:\h\<t::TestSuite::dumper\>\hpackage\h
     can't\h\[tfihs_tfihs\].,
  AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[query_dumper]: defaulting {dumper} to \E\x24self.,
  qq|$tag no defaulting|;
like $stderr, qr.(?m)\Q[query_dumper]: {namespace} isa ().,
  qq|$tag {namespace} isa scalar|;

$tag =
  q|{dumper} isa defined subroutine, {namespace} eq (t::TestSuite::dumper),|;
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::dumper|, dumper => q|shift_shift| },
  \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{aegis}, exists $bb->{matrixone}, $rc ], [ q|Waske|, '', q|Courtain| ],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[query_dumper]: going for <t::TestSuite::dumper>::[shift_shift].,
  qq|$tag noted|;

$tag =                  q|{dumper} isa defined subroutine, | .
  q|{namespace} eq (t::TestSuite::dumper), argument is set,|;
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::dumper|, dumper => q|shift_shift| },
  \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Chastiefol|;
is_deeply
[@$bb{qw| aegis slash_briefcase |}, $rc ],
[qw|  Stormbringer Chastiefol Hrunting |],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[query_dumper]: going for <t::TestSuite::dumper>::[shift_shift].,
  qq|$tag noted|;

$tag = q|{dumper} returns empty,|;
AFSMTS_class_wrap { %plug, dumper => sub { } }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply $rc, q|(unclear)|, qq|$tag queried|;

$tag = q|{dumper} returns one item, item isa scalar|;

t/base/query_source.t  view on Meta::CPAN

    shift @main::flags }

package main;
use version 0.77; our $VERSION = version->declare( v2.3.2 );

use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 62;

use Acme::FSM;

our( $bb, $rc, $stderr );
our %st    = (             );
my $method = q|query_source|;

my $tag;
our @flags =
qw| mustrum_ridcully        quirm
    djelibeybi            pteppic
    bravd                creosote
    xxxx                    tsort
    angua         ponder_stibbons

t/base/query_source.t  view on Meta::CPAN

    bel_shamharoth sergeant_colon
    great_t_phon        boy_willy
    conina               llamedos
    agnes_nitt             lancre |;

my %plug = ( diag_level => 5 );

$tag = q|{source} is missing,|;
AFSMTS_class_wrap { %plug }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
like $stderr, qr<(?m)\Q[connect]: (source): unset >, qq|$tag noted|;
AFSMTS_method_wrap $method;
like $@, qr.\Q {source} !isa defined., AFSMTS_croakson $tag;

$tag = q|{source} isa (undef),|;
AFSMTS_class_wrap { %plug, source => undef }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
like $stderr, qr<(?m)\Q[connect]: (source): unset >, qq|$tag noted|;
AFSMTS_method_wrap $method;
like $@, qr.\Q {source} !isa defined., AFSMTS_croakson $tag;

$tag = q|{source} isa (HASH),|;
AFSMTS_class_wrap { %plug, source => \$tag }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q isa (SCALAR)., AFSMTS_croakson $tag;

$tag = q|{source} isa (Acme::FSM),|;

t/base/query_source.t  view on Meta::CPAN

like $@, qr.\Q {source} isa (Acme::FSM)., AFSMTS_croakson $tag;

$tag = q|{source} isa (CODE), {namespace} unset,|;
AFSMTS_class_wrap { %plug, source => \&t::TestSuite::FSM::shift_shift }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{Ashevill_pm}, exists $bb->{Anchorage_pm}, @$rc ],
[         q|mustrum_ridcully|, '',  qw| quirm (quirm) |],
  qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_source]: {source} isa (CODE)., qq|$tag noted|;

$tag = q|{source} isa (CODE), {namespace} unset, argument isa set,|;
AFSMTS_class_wrap { %plug, source => \&t::TestSuite::FSM::shift_shift }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|brutha|;
is_deeply
[ @$bb{qw| Ashevill_pm Anchorage_pm |}, @$rc ],
[qw|    djelibeybi brutha pteppic (pteppic) |],
  qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_source]: {source} isa (CODE)., qq|$tag noted|;

$tag = q|{source} isa (CODE), {namespace} isa set,|;
AFSMTS_class_wrap
{ %plug, namespace => q|vesta|, source => \&t::TestSuite::FSM::shift_shift },
  \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{Ashevill_pm}, exists $bb->{Anchorage_pm}, @$rc ],
[               q|bravd|, '', qw| creosote (creosote) |],
  qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_source]: {source} isa (CODE)., qq|$tag noted|;

$tag = q|{source} isa (CODE), {namespace} isa set, argument isa set,|;
AFSMTS_class_wrap
{ %plug, namespace => q|vesta|, source => \&t::TestSuite::FSM::shift_shift },
  \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|littlebottom|;
is_deeply
[ @$bb{qw| Ashevill_pm Anchorage_pm |}, @$rc ],
[qw|        xxxx littlebottom tsort (tsort) |],
  qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_source]: {source} isa (CODE)., qq|$tag noted|;

$tag = q|{source} isa (), {namespace} !isa defined,|;
AFSMTS_class_wrap { %plug, source => q|vorbis| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q {namespace} !isa defined., AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[query_source]: {source} isa ()., qq|$tag noted|;

$tag = q|{source} !isa defined method, {namespace} eq (),|;
$t::TestSuite::class_cheat = q|t::TestSuite::FSM|;
AFSMTS_class_wrap { %plug, namespace => '', source => q|tfihs_tfihs| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q <t::TestSuite::FSM> can't [tfihs_tfihs] method .,
  AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[query_source]: defaulting {source} to \E\x24self.,
  qq|$tag defaulting noted|;
like $stderr, qr.(?m)\Q[query_source]: {namespace} isa (t::TestSuite::FSM).,
  qq|$tag defaulted noted|;

$tag = q|{source} isa defined method, {namespace} eq (),|;
AFSMTS_class_wrap { %plug, namespace => '', source => q|shift_shift| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{Ashevill_pm}, exists $bb->{Anchorage_pm}, @$rc ],
[ q|angua|, '', qw| ponder_stibbons (ponder_stibbons) |],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[query_source]: going for <t::TestSuite::FSM>->[shift_shift].,
  qq|$tag noted|;

$tag = q|{source} isa defined method, {namespace} eq (), argument is set,|;
AFSMTS_class_wrap { %plug, namespace => '', source => q|shift_shift| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|bel_shamharoth|;
is_deeply
[            @$bb{qw| Ashevill_pm Anchorage_pm |}, @$rc ],
[qw| king_verence bel_shamharoth sto_helit (sto_helit) |],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[query_source]: going for <t::TestSuite::FSM>->[shift_shift].,
  qq|$tag noted|;

$tag =
  q|{source} !isa defined method, {namespace} eq (t::TestSuite::source),|;
my $source = t::TestSuite::source->new;
undef $t::TestSuite::class_cheat;
AFSMTS_class_wrap
{ %plug, namespace => $source, source => q|tfihs_tfihs| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q <t::TestSuite::source> can't [tfihs_tfihs] method .,
  AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[query_source]: defaulting {source} to \E\x24self.,
  qq|$tag no defaulting|;
like $stderr,
  qr.(?m)\Q[query_source]: {namespace} isa (t::TestSuite::source).,
  qq|$tag {namespace} noted|;

$tag = q|{source} isa defined method, {namespace} eq (t::TestSuite::source),|;
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => $source, source => q|shift_shift| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[       $source->{Torino_pm}, exists $bb->{Ashevill_pm}, @$rc ],
[ q|bel_shamharoth|, '', qw| sergeant_colon (sergeant_colon) |],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[query_source]: going for <t::TestSuite::source>->[shift_shift].,
  qq|$tag noted|;

$tag =
  q|{source} isa defined method, {namespace} eq (t::TestSuite::source), | .
  q|argument is set,|;
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => $source, source => q|shift_shift| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|shawn_ogg|;
is_deeply
[          @$source{qw| Torino_pm Lund_pm |}, @$rc ],
[qw| great_t_phon shawn_ogg boy_willy (boy_willy) |],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[query_source]: going for <t::TestSuite::source>->[shift_shift].,
  qq|$tag noted|;

$tag =
  q|{source} !isa defined subroutine, {namespace} eq (t::TestSuite::source),|;
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::source|, source => q|tfihs_tfihs| },
  \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@,
  qr.(?mx)\[query_source\]:\h\<t::TestSuite::source\>\hpackage\h
     can't\h\[tfihs_tfihs\].,
  AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[query_source]: defaulting {source} to \E\x24self.,
  qq|$tag no defaulting|;
like $stderr, qr.(?m)\Q[query_source]: {namespace} isa ().,
  qq|$tag {namespace} isa scalar|;

$tag =
  q|{source} isa defined subroutine, {namespace} eq (t::TestSuite::source),|;
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::source|, source => q|shift_shift| },
  \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{Torino_pm}, exists $bb->{Ashevill_pm}, @$rc ],
[           q|conina|, '', qw| llamedos (llamedos) |],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[query_source]: going for <t::TestSuite::source>::[shift_shift].,
  qq|$tag noted|;

$tag =                  q|{source} isa defined subroutine, | .
  q|{namespace} eq (t::TestSuite::source), argument is set,|;
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::source|, source => q|shift_shift| },
  \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|reg_shoe|;
is_deeply
[     @$bb{qw| Torino_pm Lund_pm |}, @$rc ],
[qw| agnes_nitt reg_shoe lancre (lancre) |],
  qq|$tag queried|;
like $stderr,
  qr.(?m)\Q[query_source]: going for <t::TestSuite::source>::[shift_shift].,
  qq|$tag noted|;

$tag = q|{source} returns empty,|;
AFSMTS_class_wrap { source => sub { } }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply $rc, [ undef, q|(undef)| ], qq|$tag queried|;

$tag = q|{source} returns one item, item isa scalar|;

t/base/query_switch.t  view on Meta::CPAN


package main;
use version 0.77; our $VERSION = version->declare( v2.3.4 );

use t::TestSuite qw| :diag :wraps |;
use Test::More;

use Acme::FSM;
use List::Util qw| sum |;

our( $bb, $rc, $stderr );
our %st    = ( START => { switch => undef, });
my $method = q|query_switch|;

our( $lock, $tag );
our @flags =
qw| m_files     Chiocciola
    archipel  superversion
    mercurial Valdimontone
    surround_SCM     asvcs
    dcvs            Aquila

t/base/query_switch.t  view on Meta::CPAN

    my( $lfix, $rfix ) = $unit->[2]->();
    $st{START}{switch} = $lfix // $st{START}{switch};
    if( grep $_ eq q|copy|, @{$unit->[1]} )      {
                    AFSMTS_object_wrap $bb, $rfix }
    else                                         {
        AFSMTS_class_wrap { %plug, %$rfix }, \%st }
    AFSMTS_method_wrap $method, @{$unit->[3]};
    if( grep $_ eq q|pass|, @{$unit->[1]} )    {
        is_deeply [ $unit->[4]->() ], $unit->[5], qq|$unit->[0], queried|;
        grep $_ eq q|noise|, @{$unit->[1]}                            or next;
        like $stderr, $unit->[6]{$_}, qq|$unit->[0], $_|
                     foreach keys %{$unit->[6]} }
    elsif( grep $_ eq q|fail|, @{$unit->[1]} ) {
        like $@, $unit->[4], AFSMTS_croakson qq|$unit->[0], queried|;
        grep $_ eq q|noise|, @{$unit->[1]}                            or next;
        Test::More->can( index( $_, '-' ) ? q|like| : q|unlike| )->
        ( $stderr, $unit->[5]{$_}, qq|$unit->[0], $_| )
                     foreach keys %{$unit->[5]} }}

# vim: set filetype=perl

t/base/state.t  view on Meta::CPAN

use parent q|Acme::FSM|;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.1 );

use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 10;

use Acme::FSM;

our( $bb, $rc, $stderr );
my $method = q|state|;

my( $old, $new ) = qw| START OK |;
AFSMTS_class_wrap { diag_level => 10 };
isa_ok $bb, q|Acme::FSM|, q|constructed object|;
is $bb->{_}{state}, $old, qq|initial {state} isa ($old)|;

my $tag = q|no args,|;
AFSMTS_method_wrap $method;
is_deeply [ $rc, $bb->{_}{state} ], [ $old, $old ], qq|$tag queried|;

$tag = q|one arg,|;
AFSMTS_method_wrap $method, $new;
is_deeply [ $rc, $bb->{_}{state} ], [ $old, $new ], qq|$tag queried|;
like $stderr, qr<(?m)^\Q[state]: changing state: ($old) ($new)>,
  qq|$tag noted|;

$tag = q|other arg,|;
( $old, $new ) = ( $new, q|APOP| );
AFSMTS_method_wrap $method, $new;
is_deeply [ $rc, $bb->{_}{state} ], [ $old, $new ], qq|$tag queried|;
like $stderr, qr<(?m)^\Q[state]: changing state: ($old) ($new)>,
  qq|$tag noted|;

$tag = q|two args,|;
AFSMTS_method_wrap $method, qw| LIST PASS |;
is_deeply [ !defined $rc, $bb->{_}{state} ], [ !0, $new ], qq|$tag queried|;
like $stderr, qr<(?m)^\Q[state]: too many args (2) >, qq|$tag noted|;
AFSMTS_method_wrap $method;
is $rc, $new, qq|$tag {state} stays|;

# vim: set filetype=perl

t/base/turn.t  view on Meta::CPAN


package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );

use t::TestSuite qw| :diag :wraps |;
use Test::More;

use Acme::FSM;
use List::Util qw| sum |;

our( $bb, $rc, $stderr );
my %st = ( );
my %opts   = ( diag_level => -t STDOUT ? 10 : 1 );
my $method = q|turn|;

my @data =
([ '', [qw| init |], { }                                             ],
 [         q|no args, no fst|,
  [qw|                pass |],
  [                         ],
  [                0, undef ],

t/base/turn.t  view on Meta::CPAN

                  map {         $_->[1] } @data;

foreach my $unit ( @data )                                           {
    if( grep $_ eq q|init|, @{$unit->[1]}    )                      {
        %st = %{$unit->[2]};
        AFSMTS_class_wrap { %opts }, \%st                            }
    elsif( grep $_ eq q|pass|, @{$unit->[1]} )                      {
        AFSMTS_method_wrap $method, @{$unit->[2]};
        is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], $unit->[3],
          qq|$unit->[0], queried|;
        like $stderr, $unit->[4], qq|$unit->[0], noted|                 unless
          grep $_ eq q|quiet|, @{$unit->[1]}                         }
    elsif( grep $_ eq q|fail|, @{$unit->[1]} )                      {
        AFSMTS_method_wrap $method, @{$unit->[2]};
        like $@, $unit->[3], AFSMTS_croakson qq|$unit->[0], queried| }}

# vim: set filetype=perl

t/base/verify.t  view on Meta::CPAN

package main;
use version 0.77; our $VERSION = version->declare( v2.3.2 );

use t::TestSuite qw| :diag :wraps |;
use Test::More;

plan tests => 38;

use Acme::FSM;

our( %st, $bb, $rc, $stderr );
our @flags =
qw| The_Night_We_Died                Zaia
    Muh                            Ka_III
    Zombies              De_Zeuhl_Undazir
    Eliphas_Levi        Maneh_Fur_Da_Zess
    Troller_Tanz           Ek_Sun_Da_Zess
    C_est_la_Vie_Qui_les_A_Menes_La  Nono
    Do_The_Music   Da_Zeuhl_Worts_Mekanik
    Thaud                        Wainsaht
    The_Last_Seven_Minutes Nebehr_Gudahtt

t/state/break.t  view on Meta::CPAN

use warnings;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.5 );

use t::TestSuite qw| :switches :run :diag |;
use Test::More;

use Acme::FSM;

our( %st, $stderr );
our @inbase = (                                            undef, q|Roffa| );
our @input  =                                                        @inbase;
our %opts   = ( source => \&AFSMTS_shift, diag_level => -t STDOUT ? 10 : 1 );

my %common =
( state      =>       q|CONTINUE|,
  diag_level => $opts{diag_level},
  namespace  =>             undef,
  source     =>     $opts{source},
  dumper     =>             undef,

t/state/continue.t  view on Meta::CPAN

use warnings;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.5 );

use t::TestSuite qw| :switches :wraps :run :diag |;
use Test::More;

use Acme::FSM;

our( %st, $stderr, @inbase, @input );
our %opts = ( source => \&AFSMTS_shift, diag_level => -t STDOUT ? 10 : 1 );

sub toggle_now ( ) {
    @inbase = $inbase[0] ? ( undef ) x 5 : qw| mannaro | x 5;
    @input = ( )    }

my $method = q|process|;

sub combo_now ( ) { toggle_now; AFSMTS_wrap; AFSMTS_method_wrap $method }

t/state/start.t  view on Meta::CPAN

use warnings;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );

use t::TestSuite qw| :switches :run :diag |;
use Test::More;

use Acme::FSM;

our( %st, $bb, $stderr, @input );
our @inbase = q|detritus|;
our %opts   = ( source => \&AFSMTS_shift, diag_level => -t STDOUT ? 10 : 1 );

sub toggle_now ( ) {
    @inbase = $inbase[0] ? ( undef ) x 5 :
  qw| twoflower pseudopolis magrat_garlick offler granny_weatherwax |;
    @input = ( )    }

my @data =
([ q|empty state table|, [qw| void |], { }, qr.\Q{switch} !isa defined . ],

t/state/stop.t  view on Meta::CPAN

use warnings;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.5 );

use t::TestSuite qw| :switches :run :diag |;
use Test::More;

use Acme::FSM;

our( %st, $stderr );
our @inbase = ( undef, q|Roffa| );
our @input  =             @inbase;
our %opts   = ( source => \&AFSMTS_shift, diag_level => -t STDOUT ? 10 : 1 );

my %common =
( state      =>           q|STOP|,
  diag_level => $opts{diag_level},
  namespace  =>             undef,
  source     =>     $opts{source},
  dumper     =>             undef,

t/state/workload.t  view on Meta::CPAN

use warnings;

package main;
use version 0.77; our $VERSION = version->declare( v2.3.4 );

use t::TestSuite qw| :switches :run :diag |;
use Test::More;

use Acme::FSM;

our( %st, $stderr, @input );
our @inbase = q|Marriner|;
our %opts   = ( source => \&AFSMTS_shift, diag_level => -t STDOUT ? 10 : 1 );

sub toggle_now ( ) {
    @inbase = $inbase[0] ? ( undef ) x 5 :
  qw| Amelia_Ducat Delta_Magna Stegnos Davros Mawdryn |;
    @input = ( )    }

my %cache =
( tstart => { switch => sub {     1 }, tturn => [ q|workload| ]},



( run in 1.340 second using v1.01-cache-2.11-cpan-49f99fa48dc )