Acme-FSM
view release on metacpan or search on metacpan
(pass empty HASH if nothing to say).
Defined keys are:
=over
=item I<diag_level>
(positive integer)
Sets a diagnostic threshold.
It's meaning is covered in L<B<diag()> method|/diag()> documentation.
If C<undef> then set to C<1> (C<0> is B<defined>).
=item I<dumper>
(scalar or C<CODE>)
B<A::F> operates on arbitrary items and there's a diagnostic service that
sometimes insists on somehow showing those arbitrary items.
It's up to user's code to process that arbitrary data and yield some scalar
represantation.
Refer to L<B<query_dumper()> method|/query_dumper()> documentation for
details.
First element is I<$state> to change to.
Second is I<$action> that sets what to do with I<$item> upon changing to named
I<$state>.
Here are known I<[turn]>s in order of logical treating decreasing.
=over
=item C<eturn>
That I<[turn]> will be choosen by FSM itself when I<$item> at hands is
C<undef>
(as returned by B<source()>).
I<switch()> isn't invoked -- I<$item> is void, there's nothing to call
I<switch()> with.
However, I<$action> may change I<$item>.
=item C<uturn>
That I<[turn]> will be choosen by FSM if I<$rule> is C<undef>
(as returned by B<switch()>).
Idea behind this is to give an FST an option to bailout.
In original B<DMA::FSM> that's not possible (except B<croak>ing, you know).
Also, see L<B<BUGS AND CAVEATS>|/Perl FALSE, undef, and uturn>.
=item C<tturn> and/or C<fturn>
If any (hence 'or') is present then I<$rule> returned by B<switch()> is
treated as Perl boolean, except C<undef> it's handled by C<uturn>.
That's how it is in original B<DMA::FSM>.
If B<switch()> always returns TRUE (or FALSE) then C<fturn> (or C<tturn>) can
be missing.
Also, see L<B<BUGS AND CAVEATS>|/tturn, fturn, and switch()>.
=item C<turns>
If neither C<tturn> nor C<fturn> is present then whatever I<$rule> would be
returned by B<switch()> is treated as string.
That string is supposed to be a key in I<%$turns>.
=item C<CONTINUE>
Just like C<START> state (see below, all comments apply).
While C<BREAK> is turned to C<CONTINUE> implicitly no other handling is made.
=item C<START>
It's I<$state> set by B<connect()>.
I<$action> (it's also set by B<connect()>) is ignored
(if I<$action> is C<undef> then silently replaces with empty string),
B<switch()> is invoked with no arguments
(there's not anything to process yet).
Whatever I<$item> could be returned is ignored.
I<$rule> is followed.
Thus C<eturn> can't be followed.
See also L<B<BUGS AND CAVEATS>|/Special handling of START and CONTINUE>.
=item C<STOP>
It's last state in the state flow.
I<$action> is retained
(that's what B<process()> will return)
(however, because it's processed before C<STOP> state is acknowledged it must
not be C<undef>)
but otherwise ignored.
B<switch()> is invoked with no arguments
(B<switch()> of previous I<{state}> should have took care).
Whatever I<$item> could be returned is ignored.
Whatever I<$rule> could be returned is reported (at I<(basic trace)> level)
but otherwise ignored.
Then I<$action> is returned and state flow terminates.
=back
=item C<NEXT>
Drop whatever I<$item> at hands.
Request another.
If FST has such record:
somestate => { eturn => [ somestate => 'NEXT' ] }
then FSM will stay in C<somestate> as long as I<source()> callback returns
C<undef>.
Thus consuming all resources available.
No options provided to limit that consumption.
=item C<SAME>
Retains I<$item> uncoditionally.
That is, even if I<$item> isn't B<defined> it's kept anyway.
B<Beware>, if FST has such record:
$turn = $self->turn( $self->state, $branch );
$self->diag( 5, q|{%s}(%s): switch returned: (%s)|, @$turn, $branch );
$self->state( $turn->[0] );
$self->action( $turn->[1] );
my( $item, $dump ) = $self->query_source;
$self->diag( 3, q|{%s}(%s): %s: going with|, @$turn, $dump );
# No one gets out of this loop without the state tables permission!
while ( 1 ) {
# We should never see an undefined state unless we've made a mistake.
# NOTE:202201072131:whynot: As a matter of fact, we don't now.
$self->verify( $self->fst( $self->state ),
$self->state, '', q|record|, q|HASH| );
( $branch, $item ) = $self->query_switch( $item );
$self->diag( 5, q|{%s}(%s): switch returned: (%s)|, @$turn, $branch );
$dump = $self->query_dumper( $item );
$turn = $self->turn( $self->state, $branch );
$self->diag( 3, q|{%s}(%s): %s: turning with|,
$turn->[0], $branch, $dump );
my $self = shift @_;
unless( @_ ) {
return $self->{_}{state} }
elsif( 1 == @_ ) {
my $backup = $self->state;
$self->diag( 5, q|changing state: (%s) (%s)|, $backup, $_[0] );
$self->{_}{state} = shift @_;
return $backup }
else {
$self->carp( sprintf q|too many args (%i)|, scalar @_ );
return undef }}
=item B<fst()>
%state = %{ $bb->fst( $state ) };
%state = %{ $bb->fst( $state => \%new_state ) };
$value = $bb->fst( $state => $entry );
$value = $bb->fst( $state => $entry => $new_value );
Queries and sets records and entries in I<{fst}>.
That is, not only entire I<{state}>s
but components of I<{state}> are reachable too.
Modes:
=over
=item query specific I<{state}> of specific I<$state>
Executed if one scalar is passed in.
Returns a I<{state}> reference with whatever entries are set.
Silently returns C<undef> if I<$state> is missing from I<{fst}>.
=item set I<{state}> of specific I<$state>
Executed if one scalar and HASH are passed in.
Sets a I<{state}> with key/value pairs from HASH,
creating one if necessary.
Created record isa copy of HASH, not a reference
(not a true deep copy though)
(empty I<\%new_state> is fine too)
(copying isn't by design, it's implementation's quirk).
Returns record as it was before setting
(C<undef> is returned if there were no such I<$state> before).
=item query specific I<$entry> of specific I<$state>
Executed if two scalars are passed in.
Returns an entry from named state record.
=item set specific I<$entry> of specific I<$state>
Executed if two scalars and anything else are passed in
(no implicit intelligence about third parameter).
Sets an entry in named state record,
creating one (entry) if necessary.
State record must exist beforehand.
Entry isa exact value of least argument, not a copy.
Returns whatever value I<$entry> just had
(C<undef> is returned if there were none such I<$entry> before).
=back
None checks are made, except record must exist (for two latter uses).
=cut
sub fst {
my $self = shift @_;
unless( @_ ) {
$self->carp( q|no args| );
return undef }
elsif( 2 == @_ && ref $_[1] eq q|HASH| ) {
my $backup = $self->fst( $_[0] );
$self->diag( 3, q|%s {%s} record|,
( $backup ? q|updating| : q|creating| ), $_[0] );
# XXX:202202150056:whynot: Copy is a side-effect instead.
$self->{_}{fst}{shift @_} = {%{ pop @_ }};
return $backup }
elsif( !exists $self->{_}{fst}{$_[0]} ) {
$self->carp( qq|($_[0]): no such {fst} record| );
return undef }
elsif( 1 == @_ ) {
return $self->{_}{fst}{shift @_} }
elsif( 2 == @_ ) {
return $self->{_}{fst}{shift @_}{shift @_} }
elsif( 3 == @_ ) {
my $backup = $self->fst( $_[0] => $_[1] );
$self->diag( 3, q|%s {%s}{%s} entry|,
( $backup ? q|updating| : q|creating| ), @_[0,1] );
$self->{_}{fst}{shift @_}{shift @_} = pop @_;
return $backup }
else {
$self->carp( sprintf q|too many args (%i)|, scalar @_ );
return undef }}
=item B<turn()>
$bb->turn( $state ) eq '' or die;
$bb->turn( $state => 'uturn' )->[1] eq 'NEXT' or die;
Queries I<[turn]>s of arbitrary I<{state}>s.
B<turn()> doesn't manipulate entries, use L<B<fst()> method|/fst()> instead
L<if you can|/turn() and fst()>.
Modes:
This mode is entered if there is lone scalar.
Such scalar is believed to be I<$state>.
Returns something that describes what kind of least special states are
present.
Namely:
=over
=item *
C<undef> is returned if I<$state> isn't present in the I<{fst}>
(also B<carp>s).
Also see below.
=item *
Empty string is returned if there're I<tturn> and/or I<fturn> turns.
I<turns> hash is ignored in that case.
=item *
Returns C<HASH> for C<STOP> and C<BREAK> I<$state>s without any further
processing
(For those I<$state>s any I<$rule> is ignored and C<HASH> enables I<switch()>
callbacks to give more informative logs
(while that information is mangled anyway);
Probably bad idea).
=item *
C<undef> is returned if there's nothing to say --
neither I<tturn>, nor I<fturn>, nor turn map --
this record is kind of void.
The record should be studied to find out why.
B<carp>s in that case.
=back
=item query specific I<[turn]>
Two scalars are I<$state> and specially encoded I<$rule>
be in fact queried through L<B<fst()> method|/fst()> turn map needs bit more
sophisticated handling;
and that's what B<turn()> does;
in fact asking for C<turns> will result in B<croak>.
I<$action> of C<START> and C<CONTINUE> special states suffer implicit
defaulting to empty string.
=item anything else
No arguments or more then two is an non-fatal error.
Returns C<undef> (with B<carp>).
=back
=cut
# TODO:202202172011:whynot: As soon as supported perl is young enough change it to smartmatch, plz.
my %special_turns = map { $_ => 1 } qw| eturn uturn tturn fturn |;
# TODO:202202162030:whynot: Consider more elaborate (informative) returns.
sub turn {
my $self = shift @_;
unless( @_ ) {
$self->carp( q|no args| ); return undef }
elsif( 1 == @_ && !exists $self->{_}{fst}{$_[0]} ) {
$self->carp( qq|($_[0]): no such {fst} record| );
return undef }
elsif( 1 == @_ ) {
my $state = shift @_;
my $entry = $self->verify(
$self->{_}{fst}{$state}, $state, '', q|entry|, q|HASH| );
# WORKAROUND:201305070051:whynot: Otherwise there will be spurious B<carp>s about anyway useless turns in those entries.
$state eq q|STOP| || $state eq q|BREAK| and return q|HASH|;
exists $entry->{tturn} || exists $entry->{fturn} and return '';
unless( exists $entry->{turns} ) {
# XXX:201305071531:whynot: Should just B<croak> instead, probably.
$self->carp( qq|{$state}: none supported turn| );
return undef }
$self->verify( $entry->{turns}, $state, q|turns|, q|turn|, q|HASH| );
return q|HASH| }
elsif( 2 == @_ ) {
my( $state, $turn ) = @_;
my $entry;
$self->verify( $turn, $state, $turn, q|turn|, '' );
if( exists $special_turns{$turn} ) {
$entry = $self->{_}{fst}{$state}{$turn} }
elsif( !index $turn, q|turn%| ) {
$entry = $self->{_}{fst}{$state}{turns}{substr $turn, 5} }
croak sprintf q|[turn]: {%s}(%s): unknown turn|, $state, $turn }
$self->verify( $entry, $state, $turn, q|turn|, q|ARRAY| );
$self->verify( $entry->[0], $state, $turn, q|state|, '' );
# XXX:20121230140241:whynot: {START}{turn}{action} is ignored anyway.
# XXX:201305072006:whynot: {CONTINUE}{turn}{action} is ignored too.
$entry->[1] //= '' if $state eq q|START| || $state eq q|CONTINUE|;
$self->verify( $entry->[1], $state, $turn, q|action|, '' );
return $entry }
else {
$self->carp( sprintf q|too many args (%i)|, scalar @_ );
return undef }
}
=item B<action()>
$bb->action eq $action and die;
$action = $bb->action( $new_action );
Queries and sets I<$action> of B<A::F> instance.
Modes:
my $self = shift @_;
unless( @_ ) {
return $self->{_}{action} }
elsif( 1 == @_ ) {
my $backup = $self->action;
$self->diag( 5, q|changing action: (%s) (%s)|, $backup, $_[0] );
$self->{_}{action} = shift @_;
return $backup }
else {
$self->carp( sprintf q|too many args (%i)|, scalar @_ );
return undef }}
=item B<query()>
( $alpha, $bravo ) = $self->query( $what, $name, @items );
Internal method, then it becomes complicated.
Resolves I<$what> (some callback, there multiple of them) against
I<$namespace>, if necessary.
Then invokes resolved code appropriately passing I<@items> in, if any;
Product of the callback over I<@items> is returned back to the caller.
=over
=item no arguments
Special-state mode:
invoke B<switch()> with no arguments;
ignore whatever I<$item> has been possibly returned;
return I<$rule> alone.
=item I<$item> is C<undef>
EOF mode:
ignore B<switch()> completely;
return C<eturn> and C<undef>.
=item I<$item> is not C<undef>
King-size mode:
invoke B<switch()>, pass I<$item> as single argument.
return I<$rule> and I<$item>
(whatever it became after going through B<switch()>).
=back
I<$rule>, as it was returned by B<switch()>, is encoded like this:
=over
=item I<$rule> is C<undef>
Return C<uturn>.
B<(note)>
Don't verify if C<uturn> I<[turn]> exists.
=item I<$rule> is Perl TRUE and C<tturn> and/or C<fturn> are present
Return C<tturn>
B<(note)>
Don't verify if C<tturn> I<[turn]> exists.
Don't verify if turn map exists.
B<(note)>
Don't verify if C<"turn%$rule"> exists in turn map.
=back
B<switch()> is always invoked in list context even if I<$item> would be
ignored.
If I<$rule> shouldn't be paired with I<$item> it won't be
(it's safe to call B<query_switch()> in scalar context then and
there won't be any trailing C<undef>s).
=cut
sub query_switch {
my $self = shift @_;
my @turn;
# WORKAROUND:20121229000801:whynot: No B<verify()>, B<query()> does its checks by itself.
@turn = $self->query(
$self->fst( $self->state, q|switch| ),
sprintf( q|{%s}{switch}|, $self->state ),
@_ ) if !@_ || defined $_[0];
my $kind = $self->turn( $self->state );
$turn[0] =
@_ && !defined $_[0] ? q|eturn| :
# TODO:202201071700:whynot: Make C<undef> special only when C<uturn> is present, plz.
!defined $turn[0] ? q|uturn| :
# FIXME:201304230145:whynot: Defaulting to basics here looks as bad as B<croak>ing.
# TODO:202212202039:whynot: L<Default For Turn Map>.
$kind ? qq|turn%$turn[0]| :
$turn[0] ? q|tturn| : q|fturn|;
return @_ ? @turn : $turn[0] }
=item B<query_source()>
( $item, $dump ) = $self->query_source;
# WORKAROUND:20121229001530:whynot: No B<verify()>, I<{source}> can return anything.
my $item = $self->query( $self->{_}{source}, q|{source}|, @_ );
return $item, $self->query_dumper( $item ) }
=item B<query_dumper()>
$dump = $self->query_dumper( $item );
Seeks I<dumper> callback (L<configured at construction time|/dumper>).
If the callback wasn't configured uses simple hopefully informative and
C<undef> proof substitution.
Whatever the callback returns is checked to be B<defined>
(C<undef> is changed to C<"(unclear)">)
and then returned.
=cut
sub query_dumper {
my $self = shift @_;
return $self->verify(
$self->query(
# TODO:202202210258:whynot: This is inefficient, defaulting should happen in B<connect()> instead.
$self->{_}{dumper} // sub { sprintf q|(%s)|, $_[1] // q|undef| },
q|{dumper}|, @_ ) // q|(unclear)|,
# XXX:202202210304:whynot: 'source' looks like remnants of refactoring. Should investigate it deeper.
$self->state, qw| source source |, '' ) }
=item B<diag()>
$bb->diag( 3, 'going to die at %i.', __LINE__ );
Internal.
Provides unified and single-point-of-failure way to output diagnostics.
=back
=cut
sub diag {
my $self = shift @_;
$self->{_}{diag_level} >= shift @_ or return $self;
# TODO:202212222141:whynot: Since something this B<sprintf> might emit warnings. And maybe it's appropriate.
printf STDERR sprintf( qq|[%s]: %s\n|,
( split m{::}, ( caller 1 )[3])[-1], shift @_ ),
map $_ // q|(undef)|, @_;
return $self }
=item B<carp()>
$bb->carp( 'something wrong...' );
Internal.
B<carp>s consistently if I<{_}{diag_level}> is B<gt> C<0>.
=back
=item Linter
B<(missing feature)>
It might be hard to imagine,
but FST might get out of hands
(ie check F<t/process/quadratic.t>).
Indeed, some kind of (limited!) linter would be much desired.
It's missing.
=item Perl FALSE, C<undef>, and C<uturn>
B<(caveat)>
Back then B<DMA::FSM> treated C<undef> as any other Perl FALSE.
C<uturn> I<$rule> mech has made C<undef> special
(if B<switch()> returns C<undef> and C<uturn> I<{turn}> isn't present then
it's a B<croak>).
Thus, at the moment, C<undef> isn't FALSE (for B<A::F>).
This is counter-intuitive, actually.
=item Returning C<undef> for misuse
B<(bug)>
Why B<A::F> screws with caller,
in case of API violations (by returning C<undef>),
is beyond my understanding now.
=item B<source()> and I<$state>
B<(bug)> (also see L<B<switch()> and I<$item>|/switch() and $item>)
By design and legacy,
there is single point of input -- B<source()>.
IRL, multiple sources are normal.
Implementation wise that leads to B<source()> that on the fly figures out
current I<$state> and then somehow branches (sometimes branches out).
OTOH, there's some value in keeping B<switch()>es as simple as possible what
results in I<{state}> with alone C<tturn> I<{turn}> and B<switch()> that
always returns TRUE.
Changes are coming.
=item B<turn()> and B<fst()>
B<(misdesign)>
Encoding (so to speak) in use by B<turn()> (in prediction mode) is plain
stupid.
C<undef> signals two distinct conditions
(granted, both are manifest of broken I<{fst}>).
Empty string doesn't distinguish safe (both C<tturn> and C<fturn> are present)
and risky (C<tturn> or C<fturn> is missing) I<{state}>.
C<HASH> doesn't say if there's anything in turn map.
All that needs loads of workout.
=back
=cut
=item C<[fst]: creating {%s}{%s} entry>
B<(basic trace)>, L<B<fst()> method|/fst()>.
New entry named I<%s> (the latter) has been created in record named I<%s> (the
former).
=item C<[fst]: no args>
B<(warning)>, L<B<fst()> method|/fst()>.
No arguments, it's an error.
However, instead of promptly dieing, C<undef> is returned
in blind hope this will be devastating enough.
=item C<[fst]: (%s): no such {fst} record>
B<(warning)>, L<B<fst()> method|/fst()>.
Requested entry I<%s> is missing.
State record ought to exist beforehand for any usecase except
L<record creation|/set {state} of specific $state>.
=item C<[fst]: too many args (%i)>
B<(warning)>, L<B<fst()> method|/fst()>.
Too many args have been passed in.
And again, instead of prompt dieing C<undef> is returned.
=item C<[fst]: updating {%s} record>
B<(basic trace)>, L<B<fst()> method|/fst()>.
Named record (I<%s>) has been updated.
=item C<[fst]: updating {%s}{%s} entry>
B<(basic trace)>, L<B<fst()> method|/fst()>.
Named entry (I<%s>, the latter) in record I<%s> (the former) has been updated.
B<(deep trace)>, L<B<process()> method|/process()>.
Trying to enter I<$state> I<%s> (the former) with I<$action> I<%s> (the
latter).
=item C<[process]: {%s}(%s): %s: going with>
B<(basic trace)>, L<B<process()> method|/process()>.
While in I<$state> I<%s> (1st) doing I<$action> I<%s> (2nd) the I<$item>
happens to be I<%s> (3rd).
C<undef> will look like this: C<((undef))>.
=item C<[process]: {%s}(%s): %s: turning with>
B<(basic trace)>, L<B<process()> method|/process()>.
B<switch()> (of I<$state> I<%s>, the 1st) has returned I<$rule> I<%s> (2nd)
and I<$item> I<%s>.
Now dealing with this.
=item C<[process]: {%s}(%s): leaving>
B<(deep trace)>, L<B<state()> method|/state()>.
Exposes change of state from previous (former I<%s>)
to current (latter I<%s>).
=item C<[state]: too many args (%i)>
B<(warning)>, L<B<state()> method|/state()>.
Obvious.
None or one argument is supposed.
B<state()> has returned C<undef> in this case,
most probably will bring havoc in a moment.
=item C<[turn]: (%s): no such {fst} record>
B<(warning)>, L<B<turn()> method|/turn()>.
Peeking for I<[turn]>s of I<%s> I<$state> yeilds nothing, there's no such
state.
=item C<[turn]: {%s}: none supported turn>
Also, please note, C<STOP> (and C<BREAK>) is special --
it needs B<defined> I<$action> but it can be literally anything.
bravo =>
{
switch => sub {
my $item = shift;
$item % 15 ? 'charlie' :
$item % 5 ? 'delta' :
$item % 3 ? 'echo' :
undef, $item
},
uturn => [ qw/ bravo NEXT / ],
turns =>
{
charlie => [ qw/ charlie SAME / ],
delta => [ qw/ delta SAME / ],
echo => [ qw/ echo SAME / ]
}
}
Again, B<source()> supposedly produces some numbers.
Then some kind of FizBuzz happens.
Also, returning C<undef> as default raises questions.
However, it's acceptable for example.
Now, quick demonstration, that's how this FizzBuzz would look
using B<DMA::FSM> capabilities (and B<A::F> of I<v2.2.7> syntax).
bravo_foo =>
{
switch => sub {
my $item = shift;
$item % 15 ? !0 : !1, $item
t/TestSuite.pm view on Meta::CPAN
=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>
t/TestSuite.pm view on Meta::CPAN
@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
sub AFSMTS_F { push @{$_[0]{queue}}, $_[1]; ( !1, undef ) }
=item B<AFSMTS_FK()>
use t::TestSuite qw/ :switches /;
%st = ( S0 => [qw/ S0 DONE /, \&AFSMTS_FK, "", "", qw/ S0 NEXT /]);
Convinience switch.
An item is saved in I<@{$bb->{queue}>.
Returns FALSE but C<undef> and an item unaltered.
=cut
sub AFSMTS_FK { push @{$_[0]{queue}}, $_[1]; ( !1, $_[1] ) }
=item B<AFSMTS_T()>
use t::TestSuite qw/ :switches /;
%st = ( S0 => [qw/ S0 DONE /, \&AFSMTS_T, qw/ S0 NEXT /]);
Convinience switch.
An item is saved in I<@{$bb->{queue}>.
Returns TRUE and consumes an item.
=cut
sub AFSMTS_T { push @{$_[0]{queue}}, $_[1]; ( !0, undef ) }
=item B<AFSMTS_TK()>
use t::TestSuite qw/ :switches /;
%st = ( S0 => [qw/ S0 DONE /, \&AFSMTS_TK, qw/ S0 NEXT /]);
Convinience switch.
An item is saved in I<@{$bb->{queue}>.
Returns TRUE and an item unaltered.
t/TestSuite.pm view on Meta::CPAN
=item B<AFSMTS_t()>
use t::TestSuite qw/ :switches /;
%st = ( S0 => [qw/ S0 DONE /, \&AFSMTS_t, qw/ S0 NEXT /]);
Convinience switch.
Returns TRUE and consumes an item.
=cut
sub AFSMTS_t { ( !0, undef ) }
=item B<AFSMTS_tK()>
use t::TestSuite qw/ :switches /;
%st = ( S0 => [qw/ S0 DONE /, \&AFSMTS_tK, qw/ S0 NEXT /]);
Convinience switch.
Returns TRUE and an item unaltered.
=cut
t/TestSuite.pm view on Meta::CPAN
The sub-name is misleading -- this one isn't close to be drop in replacement for L<B<smartmatch>|perlop/Smartmatch Operator>
(but it has potential nevertheless).
Two B<ARRAY>s are compared for equality.
=over
=item *
If sizes of arrays differ returns C<undef>
=item *
If any two elements mismatch then returns Perl's B<FALSE>
=item *
Otherwise returns Perl's B<TRUE>
=item *
Values are treated as plain scalars (it's too early for recursion)
=back
=cut
sub AFSMTS_smartmatch ( \@\@ ) {
my( $jkCX1Y, $jlVW4H ) = @_;
@$jkCX1Y == @$jlVW4H or return undef;
not grep $jkCX1Y->[$_] ne $jlVW4H->[$_], ( 0 .. $#$jkCX1Y ) }
=item B<AFSMTS_grep()>
use t::TestSuite qw/ :utils /;
AFSTMTS_grep $item, @mass or next;
(B<v2.3.6>)
This should be in L<B<AFSMTS_smartmatch>|/AFSMTS_smartmatch()>.
But that would be too much work for testsuite support.
t/action/next.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 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 =
( state => q|STOP|,
diag_level => 1,
namespace => undef,
source => $opts{source},
dumper => undef );
%st =
( START =>
{ switch => sub { $_[0]->{queue} = [ ] },
tturn => [qw| workload VOID |] },
workload =>
{ tturn => [qw| workload NEXT |],
fturn => [qw| STOP DONE |] },
STOP => { switch => sub { } } );
t/action/next.t view on Meta::CPAN
is $input[0], q|Satan|, qq|3-queue, $tag, runs over|;
AFSMTS_wrap;
AFSMTS_deeply
@{[[qw| DONE |],
{ %common, action => q|DONE|, queue => [qw| Satan ADAM Ligur |]} ]},
qq|$tag, refrains four|;
is $input[0], q|God|, qq|4-queue, $tag, runs over|;
$tag = q|not reviving {source}|;
$opts{source} = sub { undef };
$st{workload}{switch} = sub { };
TODO: {
local $TODO = qq|$tag, should detect|;
AFSMTS_wrap;
isnt $rc->[0], qq|ALRM\n|, AFSMTS_croakson $tag }
# vim: set filetype=perl
t/action/same.t view on Meta::CPAN
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 =
( state => q|STOP|,
diag_level => 1,
namespace => undef,
source => $opts{source},
dumper => undef );
%st =
( START =>
{ switch => sub { $_[0]->{queue} = [ ] },
tturn => [qw| workload VOID |] },
workload =>
{ tturn => [qw| workload SAME |],
fturn => [qw| STOP DONE |] },
STOP => { switch => sub { } } );
t/action/same.t view on Meta::CPAN
shift @input for 0 .. 2;
AFSMTS_wrap;
AFSMTS_deeply
@{[[qw| DONE |],
{ %common, action => q|DONE|, queue => [qw| Purdue | x 3 ]} ]},
qq|$tag, refrains four|;
is $input[0], q|Women|, qq|4-queue, $tag, 3 items left behind|;
$tag = q|not reviving {source}|;
$opts{source} = sub { undef };
$st{workload}{switch} = sub { };
TODO: {
local $TODO = qq|$tag, shoild detect|;
AFSMTS_wrap;
isnt $rc->[0], qq|ALRM\n|, AFSMTS_croakson $tag }
# vim: set filetype=perl
t/action/tstl.t view on Meta::CPAN
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 =
( state => q|STOP|,
diag_level => 1,
namespace => undef,
source => $opts{source},
dumper => undef );
%st =
( START =>
{ switch => sub { $_[0]->{queue} = [ ] },
tturn => [qw| workload VOID |] },
workload =>
{ tturn => [qw| workload TSTL |],
fturn => [qw| STOP DONE |] },
STOP => { switch => sub { } } );
t/action/tstl.t view on Meta::CPAN
shift @input for 0 .. 2;
AFSMTS_wrap;
AFSMTS_deeply
@{[[qw| DONE |],
{ %common, action => q|DONE|, queue => [qw| Buchanan | x 3 ]} ]},
qq|$tag, refrains four|;
is $input[0], q|Bush|, qq|4-queue, $tag, stucks on first|;
$tag = q|not reviving {source}|;
$opts{source} = sub { undef };
$st{workload}{switch} = sub { };
TODO: {
local $TODO = qq|$tag, should detect|;
AFSMTS_wrap;
isnt $rc->[0], qq|ALRM\n|, AFSMTS_croakson $tag }
# vim: set filetype=perl
t/base/action.t view on Meta::CPAN
( $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/connect.t view on Meta::CPAN
$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>,
t/base/connect.t view on Meta::CPAN
$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},|;
t/base/fst.t view on Meta::CPAN
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
t/base/fst.t view on Meta::CPAN
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;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 1, $late ],
qq|$tag queried|;
is_deeply $bb->{_}{fst}{$fste}, $elder, qq|$tag {fst} entry stays intact|;
$tag = q|two args (SCALAR), fste is set, unknown key,|;
AFSMTS_method_wrap $method, $fste => $new;
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,|;
t/base/query.t view on Meta::CPAN
The_Last_Seven_Minutes Nebehr_Gudahtt
Udu_Wudu Kohntarkosz |;
my $tag;
my $mf = q|{havoc}|;
my %plug = ( diag_level => 5 );
$tag = q|{havoc} is missing,|;
AFSMTS_class_wrap { %plug }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, undef, $mf;
like $@, qr.\Q {havoc} !isa defined., AFSMTS_croakson $tag;
$tag = q|{havoc} isa (HASH),|;
AFSMTS_method_wrap $method, \$tag, $mf;
like $@, qr.\Q isa (SCALAR)., AFSMTS_croakson $tag;
$tag = q|{havoc} isa (Acme::FSM),|;
AFSMTS_method_wrap $method, $bb, $mf;
like $@, qr.\Q {havoc} isa (Acme::FSM)., AFSMTS_croakson $tag;
t/base/query.t view on Meta::CPAN
[@$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|;
t/base/query_dumper.t view on Meta::CPAN
Stormbringer Hrunting |;
my $method = q|query_dumper|;
my $tag;
my %plug = ( diag_level => 5 );
$tag = q|{dumper} is missing,|;
AFSMTS_class_wrap { %plug }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is $rc, q|(undef)|, qq|$tag default dumper in action|;
$tag = q|{dumper} is missing, argument isa set,|;
AFSMTS_class_wrap { %plug }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Grimtooth|;
is $rc, q|(Grimtooth)|, qq|$tag default dumper in action|;
$tag = q|{dumper} isa (undef),|;
AFSMTS_class_wrap { %plug, dumper => undef }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is $rc, q|(undef)|, qq|$tag default dumper in action|;
$tag = q|{dumper} isa (undef), argument isa scalar,|;
AFSMTS_class_wrap { %plug, dumper => undef }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Schrit|;
is $rc, q|(Schrit)|, qq|$tag default dumper in action|;
$tag = q|{dumper} isa (undef), argument isa object,|;
AFSMTS_class_wrap { %plug, dumper => undef }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, $bb;
like $rc, qr.\(Acme::FSM=HASH\(0x\w+\)\)., qq|$tag default dumper in action|;
$tag = q|{dumper} isa (HASH),|;
AFSMTS_class_wrap { %plug, dumper => \$tag }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q isa (SCALAR)., AFSMTS_croakson $tag;
t/base/query_dumper.t view on Meta::CPAN
[ @$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).,
t/base/query_source.t view on Meta::CPAN
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;
t/base/query_source.t view on Meta::CPAN
[ @$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).,
t/base/query_source.t view on Meta::CPAN
[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|;
AFSMTS_class_wrap { source => sub { q|windle_poons| } }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply $rc, [qw| windle_poons (windle_poons) |], qq|$tag queried|;
$tag = q|{source} returns one item, item isa object|;
my $obj = $bb;
AFSMTS_class_wrap { source => sub { $obj } }, \%st;
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
so6 fastcst
t/base/query_switch.t view on Meta::CPAN
return sub {
my $bb = shift @_;
$bb->{RCS} = shift @main::flags;
$bb->{CSSC} = shift @_ if @_;
return $rc, shift @main::flags }}
my %plug = ( diag_level => 5 );
my $switch;
my @data =
([ q|{switch} isa (undef)|,
[qw| fail |],
sub { undef, { } },
[ ],
qr.\Q {START}{switch} !isa defined. ],
[ q|{switch} isa (SCALAR)|,
[qw| fail noise |],
sub { \$method, { } },
[ ],
qr.\Q isa (SCALAR).,
{ noted => qr.(?m)\Q[query_switch]: {START}{switch} isa (SCALAR). } ],
[ q|{switch} isa (Acme::FSM)|,
[qw| copy fail noise |],
t/base/query_switch.t view on Meta::CPAN
qr.(?m)\Q[query_switch]: {START}{switch} isa (Acme::FSM). } ],
[ q|{switch} isa (CODE), {namespace} unset, returns TRUE, no arg|,
[qw| pass noise |],
sub { push_push( !0 ), { } },
[ ],
sub { $bb->{RCS}, exists $bb->{CSSC}, $rc },
[ q|m_files|, '', q|tturn| ],
{ noted => qr.(?m)\Q[query_switch]: {START}{switch} isa (CODE). } ],
[ q|{switch} isa (CODE), {namespace} unset, returns TRUE, arg|,
[qw| pass noise |],
sub { undef, { } },
[qw| Civetta |],
sub { @$bb{qw| RCS CSSC |}, @$rc },
[qw| archipel Civetta tturn superversion |],
{ noted => qr.(?m)\Q[query_switch]: {START}{switch} isa (CODE). } ],
[ q|{switch} isa (CODE), {namespace} unset, returns FALSE, no arg|,
[qw| pass noise |],
sub { push_push( !1 ), { } },
[ ],
sub { $bb->{RCS}, exists $bb->{CSSC}, $rc },
[ q|mercurial|, '', q|fturn| ],
{ noted => qr.(?m)\Q[query_switch]: {START}{switch} isa (CODE). } ],
[ q|{switch} isa (CODE), {namespace} unset, returns FALSE, arg|,
[qw| pass noise |],
sub { undef, { } },
[qw| Onda |],
sub { @$bb{qw| RCS CSSC |}, @$rc },
[qw| surround_SCM Onda fturn asvcs |],
{ noted => qr.(?m)\Q[query_switch]: {START}{switch} isa (CODE). } ],
[ q|{switch} isa (CODE), {namespace} isa set|,
[qw| pass noise |],
sub { push_push( !0 ), { namespace => q|vesta| } },
[ ],
sub { $bb->{RCS}, exists $bb->{CSSC}, $rc },
[ q|dcvs|, '', q|tturn| ],
{ noted => qr.(?m)\Q[query_switch]: {START}{switch} isa (CODE). } ],
[ q|{switch} isa (CODE), {namespace} isa set, argument isa set|,
[qw| pass noise |],
sub { undef, { namespace => q|vesta| } },
[qw| allfusion_harvest_change_manager |],
sub { @$bb{qw| RCS CSSC |}, @$rc },
[qw| so6 allfusion_harvest_change_manager tturn fastcst |],
{ noted => qr.(?m)\Q[query_switch]: {START}{switch} isa (CODE). } ],
[ q|{switch} isa (), {namespace} !isa defined|,
[qw| fail noise |],
sub { q|snapshotcm|, { } },
[ ],
qr.\Q {namespace} !isa defined.,
{ noted => qr.(?m)\Q[query_switch]: {START}{switch} isa (). }, ],
t/base/query_switch.t view on Meta::CPAN
[ q|{switch} isa defined method, {namespace} eq ()|,
[qw| pass noise |],
sub { q|push_push|, { namespace => '' } },
[ ],
sub { $bb->{MKS}, exists $bb->{CS_RCS}, $rc },
[ q|arx|, '', q|tturn| ],
{ noted => qr.(?xm)\[query_switch\]:\s
going\sfor\s<t::TestSuite::FSM>->\[push_push\]. } ],
[q|{switch} isa defined method, {namespace} eq (), argument is set|,
[qw| pass noise |],
sub { undef, { namespace => '' } },
[qw| darcs |],
sub { @$bb{qw| MKS CS_RCS |}, @$rc },
[qw| cvsnt darcs tturn sourceanywhere |],
{ noted => qr.(?xm)\[query_switch\]:\s
going\sfor\s<t::TestSuite::FSM>->\[push_push\]. } ],
[ q|{switch} !isa defined method, | .
q|{namespace} isa (t::TestSuite::switch)|,
[qw| fail noise noise |],
sub {
$switch = t::TestSuite::switch->new;
undef $t::TestSuite::class_cheat;
q|hsup_hsup|, { namespace => $switch } },
[ ],
qr.\Q <t::TestSuite::switch> can't [hsup_hsup] method .,
{ -misdefaulting => qr.(?xm)\[query_switch\]:\s
defaulting\s\{switch\}\sto\s\x24self.,
noted => qr.(?xm)\[query_switch\]:\s
\{namespace\}\sisa\s\(t::TestSuite::switch\). } ],
[ q|{switch} isa defined method, | .
q|{namespace} isa (t::TestSuite::switch)|,
[qw| pass noise |],
t/base/query_switch.t view on Meta::CPAN
[ ],
sub {
$switch->{jedi_vcs}, exists $switch->{gat}, exists $bb->{MKS},
$rc },
[ q|opencm|, '', '', q|tturn| ],
{ noted => qr.(?xm)\[query_switch\]:\s
going\sfor\s<t::TestSuite::switch>->\[push_push\]. } ],
[ q|{switch} isa defined method, | .
q|{namespace} isa (t::TestSuite::switch), argument is set|,
[qw| pass noise |],
sub { undef, { namespace => $switch } },
[qw| serena_version_manager |],
sub { @$switch{qw| jedi_vcs gat |}, exists $bb->{MKS}, @$rc },
[qw| cvs serena_version_manager |, '', qw| tturn codeville |],
{ noted => qr.(?xm)\[query_switch\]:\s
going\sfor\s<t::TestSuite::switch>->\[push_push\]. } ],
[ q|{switch} !isa defined subroutine, | .
q|{namespace} eq (t::TestSuite::switch)|,
[qw| fail noise noise |],
sub { q|hsup_hsup|, { namespace => q|t::TestSuite::switch| } },
[ ],
t/base/query_switch.t view on Meta::CPAN
[qw| pass noise |],
sub { q|push_push|, { namespace => q|t::TestSuite::switch| } },
[ ],
sub { $bb->{jedi_vcs}, exists $bb->{MKS}, $rc },
[ q|controltier|, '', q|tturn| ],
{ noted => qr.(?xm)\[query_switch\]:\s
going\sfor\s<t::TestSuite::switch>::\[push_push\]. } ],
[ q|{switch} isa defined subroutine, | .
q|{namespace} eq (t::TestSuite::switch), argument is set|,
[qw| pass noise |],
sub { undef, { namespace => q|t::TestSuite::switch| } },
[qw| TLIB |],
sub { @$bb{qw| jedi_vcs gat |}, exists $bb->{MKS}, @$rc },
[qw| rmtrcs TLIB |, '', qw| tturn ic_manage |],
{ noted => qr.(?xm)\[query_switch\]:\s
going\sfor\s<t::TestSuite::switch>::\[push_push\]. } ],
[q|no turns, {switch} returns empty|,
[qw| pass |],
sub { sub { }, { } },
[ ],
sub { $rc },
[qw| uturn |] ],
[q|no turns, {switch} returns empty, argument is set|,
[qw| pass |],
sub { sub { }, { } },
[qw| clearcase |],
sub { $rc },
[qw| uturn |] ],
[q|no turns, {switch} returns explicit (undef)|,
[qw| pass |],
sub { sub { undef }, { } },
[ ],
sub { $rc },
[qw| uturn |] ],
[q|no turns, {switch} returns explicit (undef), argument is set|,
[qw| pass |],
sub { sub { undef }, { } },
[qw| clearcase |],
sub { $rc },
[qw| uturn |] ],
[q|no turns, {switch} returns empty string|,
[qw| pass |],
sub { sub { '' }, { } },
[ ],
sub { $rc },
[qw| fturn |], ],
[q|no turns, {switch} returns empty string, argument is set|,
t/base/query_switch.t view on Meta::CPAN
sub { $st{START}{eturn} = [qw| START DONE |]; sub { }, { } },
[ ],
sub { $rc },
[qw| uturn |] ],
[q|{eturn}, {switch} returns empty, argument is set|,
[qw| pass |],
sub { sub { }, { } },
[qw| clearcase |],
sub { $rc },
[qw| uturn |] ],
[q|{eturn}, {switch} returns explicit (undef)|,
[qw| pass |],
sub { sub { undef }, { } },
[ ],
sub { $rc },
[qw| uturn |] ],
[q|{eturn}, {switch} returns explicit (undef), argument is set|,
[qw| pass |],
sub { sub { undef }, { } },
[qw| clearcase |],
sub { $rc },
[qw| uturn |] ],
[q|{eturn}, {switch} returns empty string|,
[qw| pass |],
sub { sub { '' }, { } },
[ ],
sub { $rc },
[qw| fturn |] ],
[q|{eturn}, {switch} returns empty string, argument is set|,
t/base/query_switch.t view on Meta::CPAN
sub { }, { } },
[ ],
sub { $rc },
[qw| uturn |] ],
[q|{uturn}, {switch} returns empty, argument is set|,
[qw| pass |],
sub { sub { }, { } },
[qw| clearcase |],
sub { $rc },
[qw| uturn |] ],
[q|{uturn}, {switch} returns empty, explicit (undef)|,
[qw| pass |],
sub { sub { undef }, { } },
[ ],
sub { $rc },
[qw| uturn |] ],
[q|{uturn}, {switch} returns explicit (undef), argument is set|,
[qw| pass |],
sub { sub { undef }, { } },
[qw| clearcase |],
sub { $rc },
[qw| uturn |] ],
[q|{uturn}, {switch} returns empty string|,
[qw| pass |],
sub { sub { '' }, { } },
[ ],
sub { $rc },
[qw| fturn |] ],
[q|{uturn}, {switch} returns empty string, argument is set|,
t/base/query_switch.t view on Meta::CPAN
sub { }, { } },
[ ],
sub { $rc },
[qw| uturn |] ],
[q|{tturn}, {switch} returns empty, argument is set|,
[qw| pass |],
sub { sub { }, { } },
[qw| clearcase |],
sub { $rc },
[qw| uturn |] ],
[q|{tturn}, {switch} returns explicit (undef)|,
[qw| pass |],
sub { sub { undef }, { } },
[ ],
sub { $rc },
[qw| uturn |] ],
[q|{tturn}, {switch} returns explicit (undef), argument is set|,
[qw| pass |],
sub { sub { undef }, { } },
[qw| clearcase |],
sub { $rc },
[qw| uturn |] ],
[q|{tturn}, {switch} returns empty string|,
[qw| pass |],
sub { sub { '' }, { } },
[ ],
sub { $rc },
[qw| fturn |] ],
[q|{tturn}, {switch} returns empty string, argument is set|,
t/base/query_switch.t view on Meta::CPAN
sub { }, { } },
[ ],
sub { $rc },
[qw| uturn |] ],
[q|{fturn}, {switch} returns empty, argument is set|,
[qw| pass |],
sub { sub { }, { } },
[qw| clearcase |],
sub { $rc },
[qw| uturn |] ],
[q|{fturn}, {switch} returns explicit (undef)|,
[qw| pass |],
sub { sub { undef }, { } },
[ ],
sub { $rc },
[qw| uturn |] ],
[q|{fturn}, {switch} returns explicit (undef), argument is set|,
[qw| pass |],
sub { sub { undef }, { } },
[qw| clearcase |],
sub { $rc },
[qw| uturn |] ],
[q|{fturn}, {switch} returns empty string|,
[qw| pass |],
sub { sub { '' }, { } },
[ ],
sub { $rc },
[qw| fturn |] ],
[q|{fturn}, {switch} returns empty string, argument is set|,
t/base/query_switch.t view on Meta::CPAN
sub { }, { } },
[ ],
sub { $rc },
[qw| uturn |] ],
[q|{turns}, {switch} returns empty, argument is set|,
[qw| pass |],
sub { sub { }, { } },
[qw| clearcase |],
sub { $rc },
[qw| uturn |] ],
[q|{turns}, {switch} returns explicit (undef)|,
[qw| pass |],
sub { sub { undef }, { } },
[ ],
sub { $rc },
[qw| uturn |] ],
[q|{turns}, {switch} returns explicit (undef), argument is set|,
[qw| pass |],
sub { sub { undef }, { } },
[qw| clearcase |],
sub { $rc },
[qw| uturn |] ],
[q|{turns}, {switch} returns empty string|,
[qw| pass |],
sub { sub { '' }, { } },
[ ],
sub { $rc },
[qw| turn% |], ],
[q|{turns}, {switch} returns empty string, argument is set|,
t/base/turn.t view on Meta::CPAN
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 ],
qr.(?m)^\Q[turn]: no args . ],
[ '',
[qw| init |],
{ KNOPPIX => undef,
Kiwi => q|BackBox|,
Tuquito => [ ],
DEFT => sub { 1 } }, ],
[ q|entry isa missing|,
[qw| pass |],
[qw| Linvo |],
[ 4, undef ],
qr.(?m)\Q(Linvo): no such {fst} . ],
[ q|entry isa undef|,
[qw| fail |],
[qw| KNOPPIX |],
qr.\Q{KNOPPIX}(): entry !isa defined . ],
[ q|entry isa scalar|,
[qw| fail |],
[qw| Kiwi |],
qr.\Q{Kiwi}(): entry isa (), . ],
[ q|entry isa (ARRAY)|,
[qw| fail |],
[qw| Tuquito |],
qr.\Q{Tuquito}(): entry isa (ARRAY), . ],
[
q|entry isa (CODE)|,
[qw| fail |],
[qw| DEFT |],
qr.\Q{DEFT}(): entry isa (CODE), . ],
[ '',
[qw| init |],
{ KNOPPIX => { },
Kiwi => { tturn => undef },
Tuquito => { fturn => undef },
Linvo => { tturn => undef, fturn => undef },
Plamo => { eturn => undef },
Gentoo => { uturn => undef },
Emmabunt => { tturn => undef, fturn => undef, turns => undef } } ],
[ q|empty entry|,
[qw| pass |],
[qw| KNOPPIX |],
[ 7, undef ],
qr.(?m)\Q{KNOPPIX}: none supported turn . ],
[ q|lone {tturn}|,
[qw| pass quiet |],
[qw| Kiwi |],
[ 7, '' ] ],
[ q|lone {fturn}|,
[qw| pass quiet |],
[qw| Tuquito |],
[ 7, '' ] ],
[
q|{tturn} plus {fturn} pair|,
[qw| pass quiet |],
[qw| Linvo |],
[ 7, '' ] ],
[ q|lone {eturn}|,
[qw| pass |],
[qw| Plamo |],
[ 7, undef ],
qr.(?m)\Q{Plamo}: none supported turn . ],
[ q|lone {uturn}|,
[qw| pass |],
[qw| Gentoo |],
[ 7, undef ],
qr.(?m)\Q{Gentoo}: none supported turn . ],
[ q|{tturn} plus {fturn} plus {turns} tripple|,
[qw| pass quiet |],
[qw| Emmabunt |],
[ 7, '' ] ],
[ '',
[qw| init |],
{ KNOPPIX => { turns => undef },
Kiwi => { turns => q|BackBox| },
Tuquito => { turns => sub { 1 } },
DEFT => { turns => { }} } ],
[ q|{turns} isa undef|,
[qw| fail |],
[qw| KNOPPIX |],
qr.\Q{KNOPPIX}(turns): turn !isa defined . ],
[ q|{turns} isa scalar|,
[qw| fail |],
[qw| Kiwi |],
qr.\Q{Kiwi}(turns): turn isa (), . ],
[ q|{turns} isa (CODE)|,
[qw| fail |],
[qw| Tuquito |],
t/base/turn.t view on Meta::CPAN
[ q|{STOP} has no turns|,
[qw| pass quiet |],
[qw| STOP |],
[ 2, q|HASH| ] ],
[ q|{BREAK} has no turns|,
[qw| pass quiet |],
[qw| BREAK |],
[ 2, q|HASH| ] ],
[ '',
[qw| init |],
{ STOP => { eturn => undef }, BREAK => { eturn => undef }} ],
[ q|{STOP} has {eturn}|,
[qw| pass quiet |],
[qw| STOP |],
[ 2, q|HASH| ] ],
[ q|{BREAK} has {eturn}|,
[qw| pass quiet |],
[qw| BREAK |],
[ 2, q|HASH| ] ],
[ '',
[qw| init |],
{ STOP => { tturn => undef }, BREAK => { tturn => undef }} ],
[ q|{STOP} has {tturn}|,
[qw| pass quiet |],
[qw| STOP |],
[ 2, q|HASH| ] ],
[ q|{BREAK} has {tturn}|,
[qw| pass quiet |],
[qw| BREAK |],
[ 2, q|HASH| ] ],
[ '',
[qw| init |],
{ STOP => { fturn => undef }, BREAK => { fturn => undef }} ],
[ q|{STOP} has {fturn}|,
[qw| pass quiet |],
[qw| STOP |],
[ 2, q|HASH| ] ],
[ q|{BREAK} has {fturn}|,
[qw| pass quiet |],
[qw| BREAK |],
[ 2, q|HASH| ] ],
[ '',
[qw| init |],
{ STOP => { turns => undef }, BREAK => { turns => undef }} ],
[ q|{STOP} has {turns}|,
[qw| pass quiet |],
[qw| STOP |],
[ 2, q|HASH| ] ],
[ q|{BREAK} has {turns}|,
[qw| pass quiet |],
[qw| BREAK |],
[ 2, q|HASH| ] ],
[ '',
[qw| init |],
{ KNOPPIX =>
{ eturn => undef,
uturn => undef,
tturn => undef,
fturn => undef },
Kiwi =>
{ eturn => q|BackBox|,
uturn => q|aLinux|,
tturn => q|EasyPeasy|,
fturn => q|CAELinux| },
Tuquito =>
{ eturn => sub { },
uturn => sub { },
tturn => sub { },
fturn => sub { } },
DEFT => { turns =>
{ Linvo => undef, Plamo => q|BRLix|, Gentoo => sub { } }} } ],
[ q|{eturn} isa undef|,
[qw| fail |],
[qw| KNOPPIX eturn |],
qr.\Q{KNOPPIX}(eturn): turn !isa defined . ],
[ q|{uturn} isa undef|,
[qw| fail |],
[qw| KNOPPIX uturn |],
qr.\Q{KNOPPIX}(uturn): turn !isa defined. ],
[ q|{tturn} isa undef|,
[qw| fail |],
[qw| KNOPPIX tturn |],
qr.\Q{KNOPPIX}(tturn): turn !isa defined. ],
[ q|{fturn} isa undef|,
[qw| fail |],
[qw| KNOPPIX fturn |],
qr.\Q{KNOPPIX}(fturn): turn !isa defined. ],
[ q|turn in {turns} isa undef|,
[qw| fail |],
[qw| DEFT turn%Linvo |],
qr.\Q{DEFT}(turn%Linvo): turn !isa defined. ],
[ q|{eturn} isa scalar|,
[qw| fail |],
[qw| Kiwi eturn |],
qr.\Q{Kiwi}(eturn): turn isa (), . ],
[ q|{uturn} isa scalar|,
[qw| fail |],
[qw| Kiwi uturn |],
t/base/turn.t view on Meta::CPAN
qr.\Q{Tuquito}(fturn): turn isa (CODE), . ],
[ q|turn in {turns} isa (CODE)|,
[qw| fail |],
[qw| DEFT turn%Gentoo |],
qr.\Q{DEFT}(turn%Gentoo): turn isa (CODE), . ],
[ '',
[qw| init |],
{ KNOPPIX =>
{ eturn => [ ], uturn => [ ], tturn => [ ], fturn => [ ]},
Kiwi =>
{ eturn => [ undef ],
uturn => [ undef ],
tturn => [ undef ],
fturn => [ undef ] },
Tuquito =>
{ eturn => [ q|BackBox| ],
uturn => [ q|aLinux| ],
tturn => [ q|EasyPeasy| ],
fturn => [ q|CAELinux| ] },
DEFT => { turns =>
{ Linvo => [ ], Plamo => [ undef ], Gentoo => [ q|BRLix| ]}} } ],
[ q|{eturn} isa empty|,
[qw| fail |],
[qw| KNOPPIX eturn |],
qr.\Q{KNOPPIX}(eturn): state !isa defined. ],
[ q|{uturn} isa empty|,
[qw| fail |],
[qw| KNOPPIX uturn |],
qr.\Q{KNOPPIX}(uturn): state !isa defined. ],
[ q|{tturn} isa empty|,
[qw| fail |],
[qw| KNOPPIX tturn |],
qr.\Q{KNOPPIX}(tturn): state !isa defined. ],
[ q|{fturn} isa empty|,
[qw| fail |],
[qw| KNOPPIX fturn |],
qr.\Q{KNOPPIX}(fturn): state !isa defined. ],
[ q|turn in {turns} isa empty|,
[qw| fail |],
[qw| DEFT turn%Linvo |],
qr.\Q{DEFT}(turn%Linvo): state !isa defined. ],
[ q|{eturn} state isa undef|,
[qw| fail |],
[qw| Kiwi eturn |],
qr.\Q{Kiwi}(eturn): state !isa defined. ],
[ q|{uturn} state isa undef|,
[qw| fail |],
[qw| Kiwi uturn |],
qr.\Q{Kiwi}(uturn): state !isa defined. ],
[ q|{tturn} state isa undef|,
[qw| fail |],
[qw| Kiwi tturn |],
qr.\Q{Kiwi}(tturn): state !isa defined. ],
[ q|{fturn} state isa undef|,
[qw| fail |],
[qw| Kiwi fturn |],
qr.\Q{Kiwi}(fturn): state !isa defined. ],
[ q|turn of {turns} state isa undef|,
[qw| fail |],
[qw| DEFT turn%Plamo |],
qr.\Q{DEFT}(turn%Plamo): state !isa defined. ],
[q|{eturn} state isa noise, action isa missing|,
[qw| fail |],
[qw| Tuquito eturn |],
qr.\Q{Tuquito}(eturn): action !isa defined. ],
[q|{uturn} state isa noise, action isa missing|,
[qw| fail |],
[qw| Tuquito uturn |],
t/base/turn.t view on Meta::CPAN
[qw| fail |],
[qw| Tuquito fturn |],
qr.\Q{Tuquito}(fturn): action !isa defined. ],
[q|turn of {turns} state isa noise, action isa missing|,
[qw| fail |],
[qw| DEFT turn%Gentoo |],
qr.\Q{DEFT}(turn%Gentoo): action !isa defined. ],
[ '',
[qw| init |],
{ KNOPPIX =>
{ eturn => [ q|BackBox|, undef ],
uturn => [ q|aLinux|, undef ],
tturn => [ q|EasyPeasy|, undef ],
fturn => [ q|CAELinux|, undef ] },
Kiwi =>
{ eturn => [qw| BRLix Super_OS |],
uturn => [qw| CCux Qubes |],
tturn => [qw| SuliX Endian |],
fturn => [qw| Caixa_M_gica Macpup |] },
Tuquito => { turns =>
{ DEFT => [ q|Emmabunt_s|, undef ],
Linvo => [qw| Gentoo Plamo |] } } } ],
[ q|{eturn} action !isa defined|,
[qw| fail |],
[qw| KNOPPIX eturn |],
qr.\Q{KNOPPIX}(eturn): action !isa defined. ],
[ q|{uturn} action !isa defined|,
[qw| fail |],
[qw| KNOPPIX uturn |],
qr.\Q{KNOPPIX}(uturn): action !isa defined. ],
[ q|{tturn} action !isa defined|,
t/base/turn.t view on Meta::CPAN
[qw| pass quiet |],
[qw| Kiwi fturn |],
[ 3, [qw| Caixa_M_gica Macpup |]] ],
[ q|correct turn of {turns}|,
[qw| pass quiet |],
[qw| Tuquito turn%Linvo |],
[ 3, [qw| Gentoo Plamo |]] ],
[ '',
[qw| init |],
{ KNOPPIX =>
{ eturn => [qw| BackBox aLinux |, undef ],
uturn => [qw| EasyPeasy CAELinux |, undef ],
tturn => [qw| BRLix Super_OS |, undef ],
fturn => [qw| CCux Qubes |, undef ] },
Kiwi => { turns =>
{ Tuquito => [qw| SuliX Endian |, undef ]}} } ],
[ q|{eturn} with trailing undef|,
[qw| pass quiet |],
[qw| KNOPPIX eturn |],
[ 2, [qw| BackBox aLinux |, undef ]] ],
[
q|{uturn} with trailing undef|,
[qw| pass quiet |],
[qw| KNOPPIX uturn |],
[ 2, [qw| EasyPeasy CAELinux |, undef ]] ],
[ q|{tturn} with trailing undef|,
[qw| pass quiet |],
[qw| KNOPPIX tturn |],
[ 2, [qw| BRLix Super_OS |, undef ]] ],
[ q|{fturn} with trailing undef|,
[qw| pass quiet |],
[qw| KNOPPIX fturn |],
[ 2, [qw| CCux Qubes |, undef ]] ],
[ q|correct turn of {turns} with trailing undef|,
[qw| pass quiet |],
[qw| Kiwi turn%Tuquito |],
[ 2, [qw| SuliX Endian |, undef ]] ],
[ '',
[qw| init |],
{ KNOPPIX =>
{ eturn => [qw| BackBox aLinux EasyPeasy |],
uturn => [qw| CAELinux BRLix Super_OS |],
tturn => [qw| CCux Qubes SuliX |],
fturn => [qw| Endian Caixa_M_gica Macpup |] },
Kiwi => { turns =>
{ Tuquito => [qw| Emmabunt_s Gentoo Plamo |] }} } ],
[ q|{eturn} trailing extra noise|,
t/base/turn.t view on Meta::CPAN
[qw| pass quiet |],
[qw| KNOPPIX fturn |],
[ 2, [qw| Endian Caixa_M_gica Macpup |]] ],
[ q|turn of {eturn} trailing extra noise|,
[qw| pass quiet |],
[qw| Kiwi turn%Tuquito |],
[ 2, [qw| Emmabunt_s Gentoo Plamo |]] ],
[ '',
[qw| init |],
{ START =>
{ eturn => [ q|BackBox|, undef ],
uturn => [ q|aLinux|, undef ],
tturn => [ q|EasyPeasy|, undef ],
fturn => [ q|CAELinux|, undef ] },
STOP =>
{ eturn => [ q|BRLix|, undef ],
uturn => [ q|Super_OS|, undef ],
tturn => [ q|CCux|, undef ],
fturn => [ q|Qubes|, undef ] },
CONTINUE =>
{ eturn => [ q|SuliX|, undef ],
uturn => [ q|Endian|, undef ],
tturn => [ q|Caixa_M_gica|, undef ],
fturn => [ q|Macpup|, undef ] },
BREAK =>
{ eturn => [ q|Emmabunt_s|, undef ],
uturn => [ q|Gentoo|, undef ],
tturn => [ q|Plamo|, undef ],
fturn => [ q|Linvo|, undef ] } } ],
[ q|{START}{eturn} action isa undef|,
[qw| pass quiet |],
[qw| START eturn |],
[ 4, [ q|BackBox|, '' ]] ],
[ q|{START}{uturn} action isa undef|,
[qw| pass quiet |],
[qw| START uturn |],
[ 4, [ q|aLinux|, '' ]] ],
[ q|{START}{tturn} action isa undef|,
[qw| pass quiet |],
[qw| START tturn |],
[ 4, [ q|EasyPeasy|, '' ]] ],
[ q|{START}{fturn} action isa undef|,
[qw| pass quiet |],
[qw| START fturn |],
[ 4, [ q|CAELinux|, '' ]] ],
[ q|{STOP}{eturn} action isa undef|,
[qw| fail |],
[qw| STOP eturn |],
qr.\Q{STOP}(eturn): action !isa defined . ],
[ q|{STOP}{uturn} action isa undef|,
[qw| fail |],
[qw| STOP uturn |],
qr.\Q{STOP}(uturn): action !isa defined . ],
[ q|{STOP}{tturn} action isa undef|,
[qw| fail |],
[qw| STOP tturn |],
qr.\Q{STOP}(tturn): action !isa defined . ],
[ q|{STOP}{fturn} action isa undef|,
[qw| fail |],
[qw| STOP fturn |],
qr.\Q{STOP}(fturn): action !isa defined . ],
[ q|{CONTINUE}{eturn} action isa undef|,
[qw| pass quiet |],
[qw| CONTINUE eturn |],
[ 4, [ q|SuliX|, '' ]] ],
[ q|{CONTINUE}{uturn} action isa undef|,
[qw| pass quiet |],
[qw| CONTINUE uturn |],
[ 4, [ q|Endian|, '' ]] ],
[ q|{CONTINUE}{tturn} action isa undef|,
[qw| pass quiet |],
[qw| CONTINUE tturn |],
[ 4, [ q|Caixa_M_gica|, '' ]] ],
[ q|{CONTINUE}{fturn} action isa undef|,
[qw| pass quiet |],
[qw| CONTINUE fturn |],
[ 4, [ q|Macpup|, '' ]] ],
[ q|{BREAK}{eturn} action isa undef|,
[qw| fail |],
[qw| BREAK eturn |],
qr.\Q{BREAK}(eturn): action !isa defined . ],
[ q|{BREAK}{uturn} action isa undef|,
[qw| fail |],
[qw| BREAK uturn |],
qr.\Q{BREAK}(uturn): action !isa defined . ],
[ q|{BREAK}{tturn} action isa undef|,
[qw| fail |],
[qw| BREAK tturn |],
qr.\Q{BREAK}(tturn): action !isa defined . ],
[ q|{BREAK}{fturn} action isa undef|,
[qw| fail |],
[qw| BREAK fturn |],
qr.\Q{BREAK}(fturn): action !isa defined . ],
[ '',
[qw| init |],
{ START => { turns => { KNOPPIX => [ q|BackBox|, undef ]}},
STOP => { turns => { Kiwi => [ q|aLinux|, undef ]}},
CONTINUE => { turns => { Tuquito => [ q|EasyPeasy|, undef ]}},
BREAK => { turns => { DEFT => [ q|CAELinux|, undef ]}} } ],
[ q|{START}{turns} action isa undef|,
[qw| pass quiet |],
[qw| START turn%KNOPPIX |],
[ 4, [ q|BackBox|, '' ]] ],
[ q|{STOP}{turns} action isa undef|,
[qw| fail |],
[qw| STOP turn%Kiwi |],
qr.\Q{STOP}(turn%Kiwi): action !isa defined . ],
[ q|{CONTINUE}{turns} action isa undef|,
[qw| pass quiet |],
[qw| CONTINUE turn%Tuquito |],
[ 4, [ q|EasyPeasy|, '' ]] ],
[ q|{BREAK}{turns} action isa undef|,
[qw| fail |],
[qw| BREAK turn%DEFT |],
qr.\Q{BREAK}(turn%DEFT): action !isa defined . ] );
plan tests => sum map {
grep( $_ eq q|init|, @$_ ) ? 0 :
grep( $_ eq q|fail|, @$_ ) ? 1 :
grep( $_ eq q|quiet|, @$_ ) ? 1 : 2 }
map { $_->[1] } @data;
t/base/verify.t view on Meta::CPAN
The_Last_Seven_Minutes Nebehr_Gudahtt
Udu_Wudu Kohntarkosz |;
my $method = q|verify|;
my $tag;
my( $mf, $wt ) = qw| {Pearl} {Tanya} |;
AFSMTS_class_wrap { debug_level => -t STDOUT ? 10 : 1 }, \%st;
isa_ok $bb, q|Acme::FSM|, q|constructed object|;
$tag = q|undefined|;
AFSMTS_method_wrap $method, undef, q|Hillary|, $wt, $mf, '';
like $@, qr.\Q{Hillary}({Tanya}): {Pearl} !isa defined., AFSMTS_croakson $tag;
my @tdata =
([ '' => q|Matt| ],
[ SCALAR => \$tag ],
[ HASH => { Mr_Cola => q|Cobb| }],
[ ARRAY => [qw| Erwin A_J |]],
[ CODE => sub { } ],
[ q|Acme::FSM| => $bb ] );
t/process/consume.t view on Meta::CPAN
package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );
use t::TestSuite qw| :switches :run :utils |;
use Test::More;
use Acme::FSM;
our( %st, $bb, $rc );
my @inbase = ( undef,
q|Vulpix|, undef,
qw| Vulpix Persian |, undef,
qw| Vulpix Persian Buoysel |, undef );
my @input = @inbase;
our %opts = ( source => sub {
@input = @inbase unless @input;
return shift @input } );
sub consume_one {
my( $bb, $item ) = @_;
push @{$bb->{found}}, $item;
return !0, undef }
sub consume_if ( & ) {
my $test = shift @_;
return sub {
my( $bb, $item ) = @_;
push @{$bb->{found}}, $item;
# XXX:202212222213:whynot: One day The Perl will bite you.
return $test->(), undef }}
my %common =
( START =>
{ switch => sub { $_[0]->{found} = [ ] }, tturn => [qw| S0 VOID |] },
STOP => { switch => sub { } } );
my %plug =
( diag_level => 1,
state => q|STOP|,
action => q|DONE|,
namespace => undef,
source => $opts{source},
dumper => undef );
my %tunits =
( q|{consume-all}| =>
[{ %common,
S0 =>
{ switch => \&consume_one,
eturn => [qw| STOP DONE |],
tturn => [qw| S0 NEXT |] } },
[[qw| DONE |], { %plug, queue => [ ], found => [ ] } ],
[[qw| DONE |], { %plug, queue => [ ], found => [qw| Vulpix |]} ],
t/process/filter.t view on Meta::CPAN
package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );
use t::TestSuite qw| :switches :run :utils |;
use Test::More;
use Acme::FSM;
our( %st, $bb, $rc );
my @inbase = ( undef,
q|Vulpix|, undef,
qw| Vulpix Persian |, undef,
qw| Vulpix Persian Buoysel |, undef );
my @input = @inbase;
our %opts = ( source => sub {
@input = @inbase unless @input;
return shift @input } );
sub consume_one {
my( $bb, $item ) = @_;
push @{$bb->{found}}, $item;
return !0, undef }
my %common =
( START =>
{ switch => sub { $_[0]->{found} = [ ] }, tturn => [qw| S0 VOID |] },
STOP => { switch => sub { } } );
my %plug =
( state => q|STOP|,
action => q|DONE|,
diag_level => 1,
namespace => undef,
source => $opts{source},
dumper => undef );
my %tunits =
# TODO:201302161629:whynot: Move that stuff to YAML and {DATA}
( q|{filter-first-with-states}| =>
[{ %common,
S0 =>
{ switch => sub { push @{$_[0]->{queue}}, $_[1] },
eturn => [qw| STOP DONE |],
tturn => [qw| S1 NEXT |] },
S1 =>
t/process/parse.t view on Meta::CPAN
use Acme::FSM;
our( %st, $bb, $rc );
my( @inbase, @input, $super );
our %opts =
( diag_level => (-t STDOUT ? 10 : 1),
namespace => '',
source => sub {
my $self = shift @_;
$self->{fail} and return undef;
return $self->{octet} ? delete $self->{octet} : shift @input } );
%st =
( START =>
{ switch => sub { 1 },
tturn => [qw| queen_of_hearts NEXT |] },
STOP => { switch => sub { } },
queen_of_hearts =>
{ switch => sub {
my( $self, $octet ) = @_;
t/process/parse.t view on Meta::CPAN
tturn => [qw| BREAK fix |],
fturn => [qw| white_queen SAME |] },
BREAK =>
{ switch => sub { my $self = shift @_; $self->{octet} } },
CONTINUE =>
{ switch => sub { 1 },
eturn => [qw| STOP finish |],
tturn => [qw| white_rabbit SAME |] } );
@inbase =
([ q||, undef, undef ],
[ q|0|, undef, 0 ],
[ q|3|, undef, 3 ],
[ q| 8|, undef, 8 ],
[ q|4 |, undef, 4 ],
[ q| 7 |, undef, 7 ],
[ q|x6|, q|no left|, undef ],
[ q|3s|, q|no op|, 3 ],
[ q|h6n|, q|no left|, undef ],
[ q|71|, undef, 71 ],
[ q| 99|, undef, 99 ],
[ q|06 |, undef, 6 ],
[ q|40+|, q|no right|, 40 ],
[ q|38-|, q|no right|, 38 ],
[ q|+16|, q|no left|, undef ],
[ q|-84|, q|no left|, undef ],
[ q|93+81|, undef, 174 ],
[ q| 76+75|, undef, 151 ],
[ q|56 +15|, undef, 71 ],
[ q|21+ 64|, undef, 85 ],
[ q|38+35 |, undef, 73 ],
[ q| 36 + 22 |, undef, 58 ],
[ q|1+0|, undef, 1 ],
[ q|0+26|, undef, 26 ],
[ q|36+y|, q|no right|, 36 ],
[ q|17++|, q|no right|, 17 ],
[ q|75+13+22|, undef, 110 ],
[ q|42+16 + 35|, undef, 93 ],
[ q|5+52+w|, q|no right|, 57 ],
[ q|22+8i|, q|no op|, 22 ],
[ q|10+75+-|, q|no right|, 85 ],
[ q| 36 + 62 + 88 + 39 |, undef, 225 ] );
plan tests => scalar @inbase;
sub do_stuff ( ) {
$bb->action eq q|fail| and return;
$bb->{fail} = q|no right| if $bb->{op} && !defined $bb->{right};
$bb->{fail} and return;
$bb->{left} = eval qq|$bb->{left} $bb->{op} $bb->{right}| if
$bb->{op} && defined $bb->{right};
$bb->{left} = eval qq|$bb->{left}| if defined $bb->{left};
t/process/parse.t view on Meta::CPAN
delete $bb->{op} }
while( my $input = shift @inbase ) {
@input = split m{}, $input->[0];
AFSMTS_wrap;
do_stuff;
until( $bb->state eq q|STOP| ) { AFSMTS_method_wrap q|process|; do_stuff }
is_deeply
[ $bb->action, @$bb{qw| fail left |} ], [ q|finish|, @$input[1 .. 2] ],
sprintf q|(%s) (%s) (%s)|,
$input->[0], $bb->{left} // q|(undef)|, $bb->{fail} // q|| }
# vim: set filetype=perl
t/process/quadratic.t view on Meta::CPAN
{ switch => sub { 1 },
tturn => [qw| st6936 NEXT |] },
STOP => { switch => sub { } },
st6936 =>
{ switch => sub {
my( $self, $octet ) = @_;
return
$octet eq '-' && !defined $self->{accum} ? ( q|minus|, '-' ) :
$octet eq ' ' ? q|space| :
$octet =~ tr/0-9// ? ( q|digit|, $octet ) :
( undef, $octet ) },
eturn => [qw| st593e NEXT |],
uturn => [qw| st2cca SAME |],
turns =>
{ minus => [qw| st3ac5 SAME |],
digit => [qw| st7af6 SAME |],
space => [qw| st6936 NEXT |] } },
st7af6 =>
{ switch => sub {
my( $self, $octet ) = @_;
$self->{accum} .= $octet;
return !0, '' },
tturn => [qw| st4d71 NEXT |] },
st4d71 =>
{ switch => sub {
my( $self, $octet ) = @_;
return
$octet ne ' ' && defined $self->{coeff2} ? ( undef, $octet ) :
$octet eq '-' && !defined $self->{accum} ? ( q|minus|, '-' ) :
$octet =~ tr/0-9// ? ( q|digit|, $octet ) :
$octet ne ' ' ? ( undef, $octet ) :
!defined $self->{coeff0} ? ( q|0|, '' ) :
!defined $self->{coeff1} ? ( q|1|, '' ) :
!defined $self->{coeff2} ? ( q|2|, '' ) :
q|space| },
eturn => [qw| st593e NEXT |],
uturn => [qw| st2cca SAME |],
turns =>
{ minus => [qw| st3ac5 SAME |],
digit => [qw| st7af6 SAME |],
0 => [qw| st00bb SAME |],
t/process/quadratic.t view on Meta::CPAN
tturn => [qw| STOP one |] },
st3ac5 =>
{ switch => sub {
my $self = shift @_;
$self->{accum} = '-';
return defined $self->{coeff0} },
tturn => [qw| st4d71 NEXT |],
fturn => [qw| st6936 NEXT |] } );
@inbase =
([ '', q|fail|, q|no coeff0|, undef, undef, undef, undef, undef ],
[ q|t|, q|fail|, q|t|, undef, undef, undef, undef, undef ],
[ q| p|, q|fail|, q|p|, undef, undef, undef, undef, undef ],
[ q|4|, q|fail|, q|no coeff0|, undef, undef, undef, undef, undef ],
[ q|9u|, q|fail|, q|u|, undef, undef, undef, undef, undef ],
[ q|5 |, q|fail|, q|no coeff1|, 5, undef, undef, undef, undef ],
[ q|52 |, q|fail|, q|no coeff1|, 52, undef, undef, undef, undef ],
[ q|-|, q|fail|, q|no coeff0|, undef, undef, undef, undef, undef ],
[ q|- |, q|fail|, q|no coeff0|, undef, undef, undef, undef, undef ],
[ q|-99 |, q|fail|, q|no coeff1|, -99, undef, undef, undef, undef ],
[ q|2-6 |, q|fail|, q|-|, undef, undef, undef, undef, undef ],
[ q|55- |, q|fail|, q|-|, undef, undef, undef, undef, undef ],
[ q|23 1|, q|fail|, q|no coeff1|, 23, undef, undef, undef, undef ],
[ q|11 q|, q|fail|, q|q|, 11, undef, undef, undef, undef ],
[ q|32 0a|, q|fail|, q|a|, 32, undef, undef, undef, undef ],
[ q|58 5 |, q|fail|, q|no coeff2|, 58, 5, undef, undef, undef ],
[ q|99 31 |, q|fail|, q|no coeff2|, 99, 31, undef, undef, undef ],
[ q|58 -|, q|fail|, q|no coeff1|, 58, undef, undef, undef, undef ],
[ q|31 - |, q|fail|, q|no coeff1|, 31, '-', undef, undef, undef ],
[ q|94 -40|, q|fail|, q|no coeff1|, 94, undef, undef, undef, undef ],
[ q|98 -51 |, q|fail|, q|no coeff2|, 98, -51, undef, undef, undef ],
[ q|71 4-1 |, q|fail|, q|-|, 71, undef, undef, undef, undef ],
[ q|99 13- |, q|fail|, q|-|, 99, undef, undef, undef, undef ],
[ q|92 70 3|, q|fail|, q|no coeff2|, 92, 70, undef, undef, undef ],
[ q|87 7 h |, q|fail|, q|h|, 87, 7, undef, undef, undef ],
[ q|77 68 2m|, q|fail|, q|m|, 77, 68, undef, undef, undef ],
[ q|45 3 -82|, q|fail|, q|no coeff2|, 45, 3, undef, undef, undef ],
[ q|43 51 1-6 |, q|fail|, q|-|, 43, 51, undef, undef, undef ],
[ q|17 10 0- |, q|fail|, q|-|, 17, 10, undef, undef, undef ],
[ q|0 0 0 |, q|any|, '', 0, 0, 0, undef, undef ],
[ q|0 0 93 |, q|none|, '', 0, 0, 93, undef, undef ],
[ q|0 32 40 |, q|one|, '', 0, 32, 40, -1.25, undef ],
[ q|0 37 0 |, q|one|, '', 0, 37, 0, 0, undef ],
[ q|22 0 0 |, q|one|, '', 22, 0, 0, 0, undef ],
[ q|67 0 63 |, q|fail|, q|no root|, 67, 0, 63, undef, undef ],
[ q|37 0 -82 |, q|two|, '', 37, 0, -82, -1.48870, 1.48870 ],
[ q|45 95 1 |, q|two|, '', 45, 95, 1, -2.10053, -0.01058 ],
[ q|95 89 75 1|, q|fail|, q|1|, 95, 89, 75, undef, undef ],
[ q|6 69 17 -|, q|fail|, q|-|, 6, 69, 17, undef, undef ],
[ q|64 92 77 v|, q|fail|, q|v|, 64, 92, 77, undef, undef ],
[ q| -13 21 38 |, q|two|, '', -13, 21, 38, 2.69858, -1.08319 ],
[ q| -24 81 84 |, q|two|, '', -24, 81, 84, 4.20696, -0.83196 ] );
plan tests => scalar @inbase;
while( my $input = shift @inbase ) {
@input = split m{}, $input->[0];
AFSMTS_wrap;
is_deeply
[ $rc->[0], @$bb{qw| fail coeff0 coeff1 coeff2 |},
(defined $input->[6] ?
abs( $input->[6] - $bb->{root}[0] ) < 0.00001 : undef) ],
[ @$input[ 1 .. 5 ], (defined $input->[6] ? !0 : undef) ],
sprintf q|(%s) (%s) (%s:%s) (%s:%s)|,
$input->[0] // q|(undef)|, $bb->{fail} // q||,
$bb->{root}[0] // q|(undef)|, $bb->{root}[1] // q|(undef)|,
$input->[6] // q|(undef)|, $input->[7] // q|(undef)| }
# vim: set filetype=perl
t/state/break.t view on Meta::CPAN
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,
queue => [ undef ] );
my @data =
([ q|no {BREAK}|,
[qw| |],
{ START => { switch => sub { 1 }, tturn => [qw| BREAK DONE |]}},
qr.\Q[verify]: {BREAK}(): record !isa defined . ],
[ q|no workload|,
[qw| |],
{ BREAK => { }},
[ qr.\Q{BREAK}(eturn): turn !isa defined .,
t/state/break.t view on Meta::CPAN
{ switch => sub { 1 }, tturn => [qw| BREAK DONE |] } },
qr.\Q{BREAK}{switch} !isa defined . ],
[ q|[F], no {BREAK}{switch}|,
[qw| eignore |],
{ workload =>
{ switch => sub { 0 }, fturn => [qw| BREAK DONE |] }},
qr.\Q{BREAK}{switch} !isa defined . ],
[ q|[U], no {BREAK}{switch}|,
[qw| eignore |],
{ workload =>
{ switch => sub { undef }, uturn => [qw| BREAK DONE |] }},
qr.\Q{BREAK}{switch} !isa defined . ],
[ q|[_], no {BREAK}{switch}|,
[qw| |],
{ workload =>
{ switch => sub { 1 },
eturn => [qw| BREAK FAIL |],
turns => { 1 => [qw| BREAK DONE |]} }},
qr.\Q{BREAK}{switch} !isa defined . ],
[ q|full-set of turns, no {BREAK}{switch}|,
[qw| |],
t/state/break.t view on Meta::CPAN
[[[qw| ace432 |], { %common, action => q|ace432| }],
[[qw| ac3bca |], { %common, action => q|ac3bca| }] ], ],
[ q|[F]{workload}(BREAK/noise)|,
[qw| pass eignore |],
{ workload =>
{ switch => sub { 0 }, fturn => [qw| BREAK acd140 |]}},
[[qw| acd140 |], { %common, action => q|acd140| }] ],
[ q|[U]{workload}(BREAK/noise)|,
[qw| pass eignore |],
{ workload =>
{ switch => sub { undef }, uturn => [qw| BREAK ac0872 |]}},
[[qw| ac0872 |], { %common, action => q|ac0872| }] ],
[ q|[_]{workload}(BREAK/noise)|,
[qw| pass eignore |],
{ workload =>
{ switch => sub { 1 }, turns => { 1 => [qw| BREAK ac7080 |]}}},
[[qw| ac7080 |], { %common, action => q|ac7080| }] ],
[ q|[T]{workload}(BREAK/undef)|,
[qw| |],
{ workload =>
{ switch => sub { 1 },
eturn => [ q|BREAK|, undef ],
tturn => [ q|BREAK|, undef ] } },
[ qr.\Q{workload}(eturn): action !isa defined .,
qr.\Q{workload}(tturn): action !isa defined . ], ],
[ q|[F]{workload}(BREAK/undef)|,
[qw| eignore |],
{ workload =>
{ switch => sub { 0 }, fturn => [ q|BREAK|, undef ]}},
qr.\Q{workload}(fturn): action !isa defined . ],
[ q|[U]{workload}(BREAK/undef)|,
[qw| eignore |],
{ workload =>
{ switch => sub { undef }, uturn => [ q|BREAK|, undef ]}},
qr.\Q{workload}(uturn): action !isa defined . ],
[ q|[_]{workload}(BREAK/undef)|,
[qw| eignore |],
{ workload =>
{ switch => sub { 1 }, turns => { 1 => [ q|BREAK|, undef ]}}},
qr.\Q{workload}(turn%1): action !isa defined . ] );
plan tests => scalar map {
( '' ) x (2 - grep q|eignore| eq $_, @{$_->[1]}) } @data;
foreach my $item ( @data ) {
$st{$_} = $item->[2]{$_} foreach keys %{$item->[2]};
if( grep q|pass| eq $_, @{$item->[1]} ) {
my $res = grep( q|eignore| eq $_, @{$item->[1]} ) ?
[ undef, $item->[3] ] : $item->[3];
AFSMTS_wrap;
AFSMTS_deeply @{$res->[0]}, qq|empty, $item->[0]| unless
grep $_ eq q|eignore|, @{$item->[1]};
AFSMTS_wrap;
AFSMTS_deeply @{$res->[1]}, qq|full, $item->[0]| }
else {
my $res = ref $item->[3] eq q|ARRAY| ?
$item->[3] : [ $item->[3], $item->[3] ];
AFSMTS_wrap;
is_deeply [ $@ =~ $res->[0], scalar @input ], [ !0, 1 ],
t/state/continue.t view on Meta::CPAN
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 }
my %common =
( state => q|CONTINUE|,
diag_level => $opts{diag_level},
namespace => undef,
source => $opts{source},
dumper => undef,
queue => [ undef ] );
my @data =
([ q|no (CONTINUE) record|,
[qw| |],
{ },
qr.\Q{CONTINUE}{switch} !isa defined . ],
[ q|empty (CONTINUE) record|,
[qw| |],
{ CONTINUE => { }},
qr.\Q{CONTINUE}{switch} !isa defined . ],
t/state/continue.t view on Meta::CPAN
[ q|[F]|,
[qw| eignore |],
{ CONTINUE => { switch => \&AFSMTS_F }},
qr.\Q{CONTINUE}(fturn): turn !isa defined . ],
[ q|[U]|,
[qw| eignore |],
{ CONTINUE => { switch => \&AFSMTS_U }},
qr.\Q{CONTINUE}(uturn): turn !isa defined . ],
[ q|[T], tturn !isa defined|,
[qw| |],
{ CONTINUE => { switch => \&AFSMTS_T, tturn => undef }},
qr.\Q{CONTINUE}(tturn): turn !isa defined . ],
[ q|[F], fturn !isa defined|,
[qw| eignore |],
{ CONTINUE => { switch => \&AFSMTS_F, fturn => undef }},
qr.\Q{CONTINUE}(fturn): turn !isa defined . ],
[ q|[U], uturn !isa defined|,
[qw| eignore |],
{ CONTINUE => { switch => \&AFSMTS_U, uturn => undef }},
qr.\Q{CONTINUE}(uturn): turn !isa defined . ],
[ q|[_], turns !isa defined|,
[qw| eignore |],
{ CONTINUE => { switch => \&AFSMTS_T, turns => { 1 => undef }}},
qr.\Q{CONTINUE}(turn%1): turn !isa defined . ],
[ q|[T], tturn isa scalar|,
[qw| |],
{ CONTINUE => { switch => \&AFSMTS_T, tturn => q|IC| }},
qr.\Q{CONTINUE}(tturn): turn isa (), should be (ARRAY) . ],
[ q|[F], fturn isa scalar|,
[qw| eignore |],
{ CONTINUE => { switch => \&AFSMTS_F, fturn => q|SC| }},
qr.\Q{CONTINUE}(fturn): turn isa (), should be (ARRAY) . ],
[ q|[U], fturn isa scalar|,
t/state/continue.t view on Meta::CPAN
{ CONTINUE => { switch => \&AFSMTS_F, fturn => [ ]}},
qr.\Q{CONTINUE}(fturn): state !isa defined . ],
[ q|[U], fturn isa empty ARRAY|,
[qw| eignore |],
{ CONTINUE => { switch => \&AFSMTS_U, uturn => [ ]}},
qr.\Q{CONTINUE}(uturn): state !isa defined . ],
[ q|[_], turns isa empty ARRAY|,
[qw| eignore |],
{ CONTINUE => { switch => \&AFSMTS_T, turns => { 1 => [ ]}}},
qr.\Q{CONTINUE}(turn%1): state !isa defined . ],
[ q|[T], state isa undef, action is missing|,
[qw| |],
{ CONTINUE => { switch => \&AFSMTS_T, tturn => [ undef ]}},
qr.\Q{CONTINUE}(tturn): state !isa defined . ],
[ q|[F], state isa undef, action is missing|,
[qw| eignore |],
{ CONTINUE => { switch => \&AFSMTS_F, fturn => [ undef ]}},
qr.\Q{CONTINUE}(fturn): state !isa defined . ],
[ q|[U], state isa undef, action is missing|,
[qw| eignore |],
{ CONTINUE => { switch => \&AFSMTS_U, uturn => [ undef ]}},
qr.\Q{CONTINUE}(uturn): state !isa defined . ],
[ q|[_], state isa undef, action is missing|,
[qw| eignore |],
{ CONTINUE =>
{ switch => \&AFSMTS_T, turns => { 1 => [ undef ]}}},
qr.\Q{CONTINUE}(turn%1): state !isa defined . ],
[ q|[T], state isa undef, action isa undef|,
[qw| |],
{ CONTINUE => { switch => \&AFSMTS_T, tturn => [ undef, undef ]}},
qr.\Q{CONTINUE}(tturn): state !isa defined . ],
[ q|[F], state isa undef, action isa undef|,
[qw| eignore |],
{ CONTINUE => { switch => \&AFSMTS_F, fturn => [ undef, undef ]}},
qr.\Q{CONTINUE}(fturn): state !isa defined . ],
[ q|[U], state isa undef, action isa undef|,
[qw| eignore |],
{ CONTINUE => { switch => \&AFSMTS_U, uturn => [ undef, undef ]}},
qr.\Q{CONTINUE}(uturn): state !isa defined . ],
[ q|[_], state isa undef, action isa undef|,
[qw| eignore |],
{ CONTINUE =>
{ switch => \&AFSMTS_T, turns => { 1 => [ undef, undef ]}}},
qr.\Q{CONTINUE}(turn%1): state !isa defined . ],
[ q|[T], state is noise, action isa undef|,
[qw| shift |],
{ CONTINUE => { switch => \&AFSMTS_T, tturn => [ q|IC|, undef ]}},
qr.\Q{IC}(): record !isa defined . ],
[ q|[F], state is noise, action isa undef|,
[qw| shift eignore |],
{ CONTINUE => { switch => \&AFSMTS_F, fturn => [ q|SC|, undef ]}},
qr.\Q{SC}(): record !isa defined . ],
[ q|[U], state is noise, action isa undef|,
[qw| shift eignore |],
{ CONTINUE => { switch => \&AFSMTS_U, uturn => [ q|RQ|, undef ]}},
qr.\Q{RQ}(): record !isa defined . ],
[ q|[_], state is noise, action isa undef|,
[qw| shift eignore |],
{ CONTINUE =>
{ switch => \&AFSMTS_T, turns => { 1 => [ q|BJ|, undef ]}}},
qr.\Q{BJ}(): record !isa defined . ],
[ q|[T], state is noise, action is noise|,
[qw| shift |],
{ CONTINUE => { switch => \&AFSMTS_T, tturn => [qw| IC AMS |]}},
qr.\Q{IC}(): record !isa defined . ],
[ q|[F], state is noise, action is noise|,
[qw| shift eignore |],
{ CONTINUE => { switch => \&AFSMTS_F, fturn => [qw| SC FLL |]}},
qr.\Q{SC}(): record !isa defined . ],
[ q|[U], state is noise, action is noise|,
[qw| shift eignore |],
{ CONTINUE => { switch => \&AFSMTS_U, uturn => [qw| RQ AFG |]}},
qr.\Q{RQ}(): record !isa defined . ],
[ q|[_], state is noise, action is noise|,
[qw| shift eignore |],
{ CONTINUE =>
{ switch => \&AFSMTS_T, turns => { 1 => [qw| BJ DBS |]}}},
qr.\Q{BJ}(): record !isa defined . ],
[ q|[T], trailing undef|,
[qw| shift |],
{ CONTINUE =>
{ switch => \&AFSMTS_T, tturn => [ q|IC|, undef, undef ]}},
qr.\Q{IC}(): record !isa defined . ],
[ q|[F], trailing undef|,
[qw| shift eignore |],
{ CONTINUE =>
{ switch => \&AFSMTS_F, fturn => [ q|SC|, undef, undef ]}},
qr.\Q{SC}(): record !isa defined . ],
[ q|[U], trailing undef|,
[qw| shift eignore |],
{ CONTINUE =>
{ switch => \&AFSMTS_U, uturn => [ q|RQ|, undef, undef ]}},
qr.\Q{RQ}(): record !isa defined . ],
[ q|[_], trailing undef|,
[qw| shift eignore |],
{ CONTINUE =>
{ switch => \&AFSMTS_T,
turns => { 1 => [ q|BJ|, undef, undef ]}} },
qr.\Q{BJ}(): record !isa defined . ],
[ q|[T], trailing noise|,
[qw| shift |],
{ CONTINUE =>
{ switch => \&AFSMTS_T, tturn => [ q|IC|, undef, q|JD| ]}},
qr.\Q{IC}(): record !isa defined . ],
[ q|[F], trailing noise|,
[qw| shift eignore |],
{ CONTINUE =>
{ switch => \&AFSMTS_F, fturn => [ q|SC|, undef, q|PB| ]}},
qr.\Q{SC}(): record !isa defined . ],
[ q|[U], trailing noise|,
[qw| shift eignore |],
{ CONTINUE =>
{ switch => \&AFSMTS_U, uturn => [ q|RQ|, undef, q|RC| ]}},
qr.\Q{RQ}(): record !isa defined . ],
[ q|[_], trailing noise|,
[qw| shift eignore |],
{ CONTINUE =>
{ switch => \&AFSMTS_T,
turns => { 1 => [ q|BJ|, undef, q|MF| ]}} },
qr.\Q{BJ}(): record !isa defined . ],
[ q|(CONTINUE/noise)|,
[qw| |],
{ CONTINUE =>
{ eturn => [ ],
uturn => [ ],
tturn => [ ],
fturn => [ ],
turns => { } } },
qr.\Q{CONTINUE}{switch} !isa defined . ],
t/state/continue.t view on Meta::CPAN
eturn => [qw| BREAK bodine |],
tturn => [qw| BREAK godolphin |] },
BREAK => { switch => \&AFSMTS_T } );
AFSMTS_wrap;
AFSMTS_deeply @{[[qw| bodine |], { %common, action => q|bodine| }]},
qq|FST sample consumes empty|;
toggle_now;
AFSMTS_wrap;
AFSMTS_deeply
@{[[qw| godolphin |],
{ %common, action => q|godolphin|, queue => [ q|mannaro|, undef ]} ]},
qq|FST sample consumes one|;
foreach my $item ( @data ) {
$st{$_} = $item->[2]{$_} foreach keys %{$item->[2]};
if( grep q|todo| eq $_, @{$item->[1]} ) {
local $TODO = q|should detect|;
combo_now;
unlike $@, qr.^ALRM., qq|empty, $item->[0]| unless
grep $_ eq q|eignore|, @{$item->[1]};
combo_now;
t/state/start.t view on Meta::CPAN
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 . ],
[ q|empty (START) record|,
[qw| void |],
{ START => { }},
qr.\Q{switch} !isa defined . ],
[ q|no (START) state|,
t/state/start.t view on Meta::CPAN
[ q|[F]|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_F }},
qr.\Q(fturn): turn !isa defined . ],
[ q|[U]|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_U }},
qr.\Q(uturn): turn !isa defined . ],
[ q|[T], tturn !isa defined|,
[qw| void |],
{ START => { switch => \&AFSMTS_T, tturn => undef }},
qr.\Q(tturn): turn !isa defined . ],
[ q|[F], fturn !isa defined|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_F, fturn => undef }},
qr.\Q(fturn): turn !isa defined . ],
[ q|[U], uturn !isa defined|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_U, uturn => undef }},
qr.\Q(uturn): turn !isa defined . ],
[ q|[T], turns !isa defined|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_T, turns => { 1 => undef }}},
qr.\Q(turn%1): turn !isa defined . ],
[ q|[T], tturn isa scalar|,
[qw| void |],
{ START => { switch => \&AFSMTS_T, tturn => q|Ursa| }},
qr.\Q(tturn): turn isa (), should be (ARRAY) . ],
[ q|[F], fturn isa scalar|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_F, fturn => q|Ursa| }},
qr.\Q(fturn): turn isa (), should be (ARRAY) . ],
[ q|[U], uturn isa scalar|,
t/state/start.t view on Meta::CPAN
{ START => { switch => \&AFSMTS_F, fturn => [ ]}},
qr.\Q(fturn): state !isa defined . ],
[ q|[U], uturn isa empty ARRAY|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_U, uturn => [ ]}},
qr.\Q(uturn): state !isa defined . ],
[ q|[T], turns isa empty ARRAY|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_T, turns => { 1 => [ ]}}},
qr.\Q(turn%1): state !isa defined . ],
[ q|[T], state isa undef, action is missing|,
[qw| void |],
{ START => { switch => \&AFSMTS_T, tturn => [ undef ]}},
qr.\Q(tturn): state !isa defined . ],
[ q|[F], state isa undef, action is missing|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_F, fturn => [ undef ]}},
qr.\Q(fturn): state !isa defined . ],
[ q|[U], state isa undef, action is missing|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_U, uturn => [ undef ]}},
qr.\Q(uturn): state !isa defined . ],
[ q|[T_], state isa undef, action is missing|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_T, turns => { 1 => [ undef ]}}},
qr.\Q(turn%1): state !isa defined. ],
[ q|[T], state isa undef, action isa undef|,
[qw| void |],
{ START => { switch => \&AFSMTS_T, tturn => [ undef, undef ]}},
qr.\Q(tturn): state !isa defined . ],
[ q|[F], state isa undef, action isa undef|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_F, fturn => [ undef, undef ]}},
qr.\Q(fturn): state !isa defined . ],
[ q|[U], state isa undef, action isa undef|,
[qw| void eignore |],
{ START => { switch => \&AFSMTS_U, uturn => [ undef, undef ]}},
qr.\Q(uturn): state !isa defined . ],
[ q|[T_], state isa undef, action isa undef|,
[qw| void eignore |],
{ START =>
{ switch => \&AFSMTS_T, turns => { 1 => [ undef, undef ]}}},
qr.\Q(turn%1): state !isa defined . ],
[ q|[T], state is noise, action isa undef|,
[qw| |],
{ START => { switch => \&AFSMTS_T, tturn => [ q|zircon|, undef ]}},
qr.\Q{zircon}(): record !isa defined . ],
[ q|[F], state is noise, action isa undef|,
[qw| eignore |],
{ START => { switch => \&AFSMTS_F, fturn => [ q|jadeite|, undef ]}},
qr.\Q{jadeite}(): record !isa defined . ],
[ q|[U], state is noise, action isa undef|,
[qw| eignore |],
{ START => { switch => \&AFSMTS_U, uturn => [ q|turquoise|, undef ]}},
qr.\Q{turquoise}(): record !isa defined . ],
[ q|[T_], state is noise, action isa undef|,
[qw| eignore |],
{ START =>
{ switch => \&AFSMTS_T, turns => { 1 => [ q|garnet|, undef ]}}},
qr.\Q{garnet}(): record !isa defined . ],
[ q|(START/noise)|,
[qw| void |],
{ START =>
{ eturn => [ ],
uturn => [ ],
tturn => [ ],
fturn => [ ],
turns => { } } },
qr.\Q{switch} !isa defined . ],
t/state/start.t view on Meta::CPAN
qr.\Q[verify]: {jadeite}(): record !isa defined . ],
[ q|[U](noise/noise)|,
[qw| eignore |],
{ START => { switch => \&AFSMTS_U, uturn => [qw| turquoise Peric |]}},
qr.\Q[verify]: {turquoise}(): record !isa defined . ],
[ q|[_](noise/noise)|,
[qw| eignore |],
{ START =>
{ switch => \&AFSMTS_T, turns => { 1 => [qw| garnet Janno |]}}},
qr.\Q[verify]: {garnet}(): record !isa defined . ],
[ q|[T], trailing undef|,
[qw| |],
{ START =>
{ switch => \&AFSMTS_T, tturn => [ q|zircon|, undef, undef ]}},
qr.\Q{zircon}(): record !isa defined . ],
[ q|[F], trailing undef|,
[qw| eignore |],
{ START =>
{ switch => \&AFSMTS_F, fturn => [ q|jadeite|, undef, undef ]}},
qr.\Q{jadeite}(): record !isa defined . ],
[ q|[U], trailing undef|,
[qw| eignore |],
{ START =>
{ switch => \&AFSMTS_U, uturn => [ q|turquoise|, undef, undef ]}},
qr.\Q{turquoise}(): record !isa defined . ],
[ q|[_], trailing undef|,
[qw| eignore |],
{ START =>
{ switch => \&AFSMTS_T,
turns => { 1 => [ q|garnet|, undef, undef ]} }},
qr.\Q{garnet}(): record !isa defined . ],
[ q|[T], trailing noise|,
[qw| |],
{ START =>
{ switch => \&AFSMTS_T, tturn => [ q|zircon|, undef, q|Rilla| ]}},
qr.\Q{zircon}(): record !isa defined . ],
[ q|[F], trailing noise|,
[qw| eignore |],
{ START =>
{ switch => \&AFSMTS_F, fturn => [ q|jadeite|, undef, q|Rilla| ]}},
qr.\Q{jadeite}(): record !isa defined . ],
[ q|[U], trailing noise|,
[qw| eignore |],
{ START =>
{ switch => \&AFSMTS_U, uturn => [ q|truquoise|, undef, q|Rilla| ]}},
qr.\Q{truquoise}(): record !isa defined . ],
[ q|[_], trailing noise|,
[qw| eignore |],
{ START =>
{ switch => \&AFSMTS_T,
turns => { 1 => [ q|garnet|, undef, q|Rilla| ]} }},
qr.\Q{garnet}(): record !isa defined . ] );
plan tests =>
scalar map { ( '' ) x ( 2 - grep( q|eignore| eq $_, @{$_->[1]})) } @data;
foreach my $item ( @data ) {
%st = %{$item->[2]};
if( grep q|todo| eq $_, @{$item->[1]} ) {
local $TODO = q|should detect|;
toggle_now;
t/state/stop.t view on Meta::CPAN
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,
queue => [ undef ] );
my @data =
([ q|no {STOP}|,
[qw| |],
{ START => { switch => sub { 1 }, tturn => [qw| STOP DONE |]}},
qr.\Q[verify]: {STOP}(): record !isa defined . ],
[ q|no workload|,
[qw| |],
{ STOP => { }},
[ qr.\Q{STOP}(eturn): turn !isa defined .,
t/state/stop.t view on Meta::CPAN
tturn => [qw| STOP applesauce |] } },
[[[qw| offal |], { %common, action => q|offal| }],
[[qw| applesauce |], { %common, action => q|applesauce| }] ] ],
[ q|[workload:F](STOP/noise)|,
[qw| pass eignore |],
{ workload => { switch => sub { 0 }, fturn => [qw| STOP hogwash |]}},
[[qw| hogwash |], { %common, action => q|hogwash| }] ],
[ q|[workload:U](STOP/noise)|,
[qw| pass eignore |],
{ workload =>
{ switch => sub { undef }, uturn => [qw| STOP garbage |]}},
[[qw| garbage |], { %common, action => q|garbage| }] ],
[ q|[workload:_](STOP/noise)|,
[qw| pass eignore |],
{ workload =>
{ switch => sub { 1 }, turns => { 1 => [qw| STOP refuse |]}}},
[[qw| refuse |], { %common, action => q|refuse| }] ],
[ q|[workload:T](STOP/undef)|,
[qw| |],
{ workload =>
{ switch => sub { 1 },
eturn => [ q|STOP|, undef ],
tturn => [ q|STOP|, undef ] } },
[ qr.\Q{workload}(eturn): action !isa defined .,
qr.\Q{workload}(tturn): action !isa defined . ] ],
[ q|[workload:F](STOP/undef)|,
[qw| eignore |],
{ workload => { switch => sub { 0 }, fturn => [ q|STOP|, undef ]}},
qr.\Q{workload}(fturn): action !isa defined . ],
[ q|[workload:U](STOP/undef)|,
[qw| eignore |],
{ workload => { switch => sub { undef }, uturn => [ q|STOP|, undef ]}},
qr.\Q{workload}(uturn): action !isa defined . ],
[ q|[workload:_](STOP/undef)|,
[qw| eignore |],
{ workload =>
{ switch => sub { 1 }, turns => { 1 => [ q|STOP|, undef ]}}},
qr.\Q{workload}(turn%1): action !isa defined . ] );
plan tests => scalar map {
( '' ) x (2 - grep q|eignore| eq $_, @{$_->[1]}) } @data;
foreach my $item ( @data ) {
$st{$_} = $item->[2]{$_} foreach keys %{$item->[2]};
if( grep q|pass| eq $_, @{$item->[1]} ) {
my $res = grep( q|eignore| eq $_, @{$item->[1]} ) ?
[ undef, $item->[3] ] : $item->[3];
local $TODO = q|should detect|;
AFSMTS_wrap;
AFSMTS_deeply @{$res->[0]}, qq|empty, $item->[0]| unless
grep $_ eq q|eignore|, @{$item->[1]};
AFSMTS_wrap;
AFSMTS_deeply @{$res->[1]}, qq|full, $item->[0]| }
else {
my $res = ref $item->[3] eq q|ARRAY| ?
$item->[3] : [ $item->[3], $item->[3] ];
AFSMTS_wrap;
t/state/workload.t view on Meta::CPAN
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| ]},
fstart => { switch => sub { 0 }, fturn => [ q|workload| ]},
ustart => { switch => sub { undef }, uturn => [ q|workload| ]} );
my @data =
([ q|no {START}{tturn}{action}|,
[qw| |],
{ START =>
{ switch => sub { 1 }, tturn => [ q|workload|, undef ]},
workload => { switch => \&AFSMTS_D } },
[ qr.\Q{workload}(eturn): turn !isa defined .,
qr.^die switch . ] ],
[ q|no {START}{fturn}{action}|,
[qw| eignore |],
{ START =>
{ switch => sub { 0 }, fturn => [ q|workload|, undef ]},
workload => { switch => \&AFSMTS_D } },
qr.^die switch . ],
[ q|no {START}{uturn}{action}|,
[qw| eignore |],
{ START =>
{ switch => sub { undef }, uturn => [ q|workload|, undef ]},
workload => { switch => \&AFSMTS_D } },
qr.^die switch . ],
[ q|unknown {START}{tturn}{action}|,
[qw| |],
{ START =>
{ switch => sub { 1 }, tturn => [qw| workload XIV |]},
workload => { switch => \&AFSMTS_D } },
[ qr.\Q{workload}(eturn): turn !isa defined .,
qr.^die switch . ] ],
[ q|unknown {START}{fturn}{action}|,
[qw| eignore |],
{ START =>
{ switch => sub { 0 }, fturn => [qw| workload XIV |]},
workload => { switch => \&AFSMTS_D } },
qr.^die switch . ],
[ q|unknown {START}{uturn}{action}|,
[qw| eignore |],
{ START =>
{ switch => sub { undef }, uturn => [qw| workload XIV |]},
workload => { switch => \&AFSMTS_D } },
qr.^die switch . ],
[ q|no {workload}(tturn)|,
[qw| |],
{ workload => { }},
[ qr.\Q{workload}(eturn): turn !isa defined .,
qr.\Q{workload}{switch} !isa defined . ] ],
[ q|no {workload}(fturn)|,
[qw| eignore |],
{ workload => { }},
t/state/workload.t view on Meta::CPAN
[qw| eignore |],
{ workload => { switch => \&AFSMTS_F, fturn => [ ]}},
qr.\Q{workload}(fturn): state !isa defined . ],
[ q|empty {workload}(uturn)|,
[qw| eignore |],
{ workload => { switch => \&AFSMTS_U, uturn => [ ]}},
qr.\Q{workload}(uturn): state !isa defined . ],
[ q|{workload}{tturn} !isa defined|,
[qw| |],
{ workload =>
{ switch => \&AFSMTS_T, eturn => [ undef ], tturn => [ undef ]}},
[ qr.\Q{workload}(eturn): state !isa defined .,
qr.\Q{workload}(tturn): state !isa defined . ] ],
[ q|{workload}{fturn} !isa defined|,
[qw| eignore |],
{ workload => { switch => \&AFSMTS_F, fturn => [ undef ]}},
qr.\Q{workload}(fturn): state !isa defined . ],
[ q|{workload}{uturn} !isa defined|,
[qw| eignore |],
{ workload => { switch => \&AFSMTS_U, uturn => [ undef ]}},
qr.\Q{workload}(uturn): state !isa defined . ],
[ q|[T], (noise/undef)|,
[qw| |],
{ workload =>
{ switch => \&AFSMTS_T,
eturn => [ q|MDCXLV|, undef ],
tturn => [ q|MMCCXV|, undef ] } },
[ qr.\Q{workload}(eturn): action !isa defined .,
qr.\Q{workload}(tturn): action !isa defined . ] ],
[ q|[F], (noise/undef)|,
[qw| eignore |],
{ workload =>
{ switch => \&AFSMTS_F, fturn => [ q|MCXCIV|, undef ]}},
qr.\Q{workload}(fturn): action !isa defined . ],
[ q|[U], (noise/undef)|,
[qw| eignore |],
{ workload =>
{ switch => \&AFSMTS_U, uturn => [ q|DCCXLI|, undef ]}},
qr.\Q{workload}(uturn): action !isa defined . ],
[ q|[T], (noise/noise)|,
[qw| |],
{ workload =>
{ switch => \&AFSMTS_T,
eturn => [qw| MDCXLV MDCLXVII |],
tturn => [qw| MMCCXV MMCCCXLV |] } },
[ qr.\Q{MDCXLV}(MDCLXVII): unknown action .,
qr.\Q{MMCCXV}(MMCCCXLV): unknown action . ] ],
[ q|[F], (noise/noise)|,
t/state/workload.t view on Meta::CPAN
[ qr.\Q{MDCXLV}(): record !isa defined .,
qr.\Q{MMCCXV}(): record !isa defined . ] ],
[ q|[F], (noise/NEXT)|,
[qw| push eignore |],
{ workload => { switch => \&AFSMTS_F, fturn => [qw| MMCCXV NEXT |]}},
qr.\Q{MMCCXV}(): record !isa defined . ],
[ q|[U], (noise/NEXT)|,
[qw| push eignore |],
{ workload => { switch => \&AFSMTS_U, uturn => [qw| DCCXLI NEXT |]}},
qr.\Q{DCCXLI}(): record !isa defined . ],
[ q|[T], trailing undef|,
[qw| push |],
{ workload =>
{ switch => \&AFSMTS_T,
eturn => [qw| MDCXLV NEXT |, undef ],
tturn => [qw| MMCCXV NEXT |, undef ] }},
[ qr.\Q{MDCXLV}(): record !isa defined .,
qr.\Q{MMCCXV}(): record !isa defined . ] ],
[ q|[F], trailing undef|,
[qw| push eignore |],
{ workload =>
{ switch => \&AFSMTS_F, fturn => [qw| MMCCXV NEXT |, undef ]}},
qr.\Q{MMCCXV}(): record !isa defined . ],
[ q|[U], trailing undef|,
[qw| push eignore |],
{ workload =>
{ switch => \&AFSMTS_U, uturn => [qw| DCCXLI NEXT |, undef ]}},
qr.\Q{DCCXLI}(): record !isa defined . ],
[ q|[T], trailing noise|,
[qw| push |],
{ workload =>
{ switch => \&AFSMTS_T,
eturn => [qw| MDCXLV NEXT MDCLXVII |],
tturn => [qw| MMCCXV NEXT MMCCCXLV |] }},
[ qr.\Q{MDCXLV}(): record !isa defined .,
qr.\Q{MMCCXV}(): record !isa defined . ] ],
[ q|[F], trailing noise|,
( run in 2.876 seconds using v1.01-cache-2.11-cpan-d80b1682f3f )