Acme-FSM
view release on metacpan or search on metacpan
No such thing.
It's I<$rule> instead (see above).
=item I<[turn]>
Specially crafted entry in I<{state}>
(covered in details in L<B<process()> method|/process()> description).
Such entry describes what next I<$state> should be picked in state flow
and what to do with I<$item>.
=item turn map
This idiom is used in place of "C<turns> I<$rule> of I<[turn]>".
=back
=cut
=head1 B<connect()>
$bb1 = Acme::FSM->connect( { %options1 }, %fst1 );
(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 *
C<HASH> is returned if there's turn map
(and neither I<tturn> nor I<fturn> is present).
B<(note)> In that case, B<turn()> checks for I<turns> is indeed a HASH,
nothing more
(however B<croaks> if that's not the case);
It may as well be empty;
Design legacy.
=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>
(refer to L<B<query_switch()> method|/query_switch()> about encoding).
If I<$rule> can't be decoded then B<croak>s.
Returns (after verification) requested I<$rule> as ARRAY.
While straightforward I<[turn]>s (such as C<tturn>, C<fturn>, and such) could
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 @_;
=item I<$rule> is Perl FALSE and C<tturn> and/or C<fturn> are present
Return C<fturn>
B<(note)>
Don't verify if C<fturn> I<[turn]> exists.
=item neither C<tturn> or C<fturn> are present
Encode I<$rule> like this C<'turn%' . $rule> and return that.
B((note)>
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
=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
unshift @_, sprintf q|[%s]: |, ( split m{::}, ( caller 1 )[3])[-1];
&Carp::carp }
=head1 BUGS AND CAVEATS
=over
=item Default For Turn Map
B<(missing feature)>
It's not hard to imagine application of rather limited turn map that should
default on anything else deemed irrelevant.
Right now to achieve logic like this such defaulting ought to be merged into
B<switch()>.
That's insane.
=item Diagnostics
B<(misdesign)>
Mechanics behind diagnostics isa failure.
It's messy, fragile, misguided, and (honestly) premature.
=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
=head1 DIAGNOSTICS
=over
t/TestSuite.pm view on Meta::CPAN
( diag => [qw| &AFSMTS_diag &AFSMTS_dump &AFSMTS_croakson |],
utils => [qw| &AFSMTS_smartmatch &AFSMTS_grep |],
run =>
[qw| &AFSMTS_wrap &AFSMTS_croakson &AFSMTS_deeply &AFSMTS_shift |],
wraps =>
[qw| &AFSMTS_class_wrap &AFSMTS_object_wrap &AFSMTS_method_wrap |],
switches =>
[qw| &AFSMTS_U &AFSMTS_Uk &AFSMTS_F &AFSMTS_FK &AFSMTS_T
&AFSMTS_TK &AFSMTS_t &AFSMTS_tK &AFSMTS_D &AFSMTS_E
&AFSMTS_EK |] );
our @EXPORT_OK = ( map @$_, values %EXPORT_TAGS );
use Module::Build;
use Carp qw| croak |;
=head1 NAME
TestSuite.pm - service routines of Acme::FSM build
=head1 ACCESSORIES
t/base/query_switch.t view on Meta::CPAN
[ ],
sub { $rc },
[qw| turn%bitkeeper |] ],
[q|{turns}, {switch} returns two items, argument is set|,
[qw| pass |],
sub { sub { qw| bitkeeper evolution | }, { } },
[qw| sccs |],
sub { @$rc },
[qw| turn%bitkeeper evolution |] ] );
plan tests => sum map {
( grep( $_ eq q|pass|, @$_ ) ? 1 :
grep( $_ eq q|fail|, @$_ ) ? 1 : 0 ) +
grep( $_ eq q|noise|, @$_ ) }
map { $_->[1] } @data;
foreach my $unit ( @data ) {
my( $lfix, $rfix ) = $unit->[2]->();
$st{START}{switch} = $lfix // $st{START}{switch};
if( grep $_ eq q|copy|, @{$unit->[1]} ) {
AFSMTS_object_wrap $bb, $rfix }
else {
AFSMTS_class_wrap { %plug, %$rfix }, \%st }
AFSMTS_method_wrap $method, @{$unit->[3]};
if( grep $_ eq q|pass|, @{$unit->[1]} ) {
t/base/turn.t view on Meta::CPAN
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;
foreach my $unit ( @data ) {
if( grep $_ eq q|init|, @{$unit->[1]} ) {
%st = %{$unit->[2]};
AFSMTS_class_wrap { %opts }, \%st }
elsif( grep $_ eq q|pass|, @{$unit->[1]} ) {
AFSMTS_method_wrap $method, @{$unit->[2]};
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], $unit->[3],
qq|$unit->[0], queried|;
like $stderr, $unit->[4], qq|$unit->[0], noted| unless
t/base/verify.t view on Meta::CPAN
[ SCALAR => \$tag ],
[ HASH => { Mr_Cola => q|Cobb| }],
[ ARRAY => [qw| Erwin A_J |]],
[ CODE => sub { } ],
[ q|Acme::FSM| => $bb ] );
foreach my $outer ( @tdata ) {
foreach my $inner ( @tdata ) {
if( $outer->[0] eq $inner->[0] ) {
$tag = sprintf q|%s isa %s|,
map { $_ eq '' ? q|scalar| : qq|($_)| }
$outer->[0], $inner->[0];
AFSMTS_method_wrap
$method, $outer->[1], q|Sid|, $wt, $mf, $inner->[0];
is $rc, $outer->[1], qq|unaffected ($tag)| }
else {
$tag = sprintf q|%s !isa %s|,
map { $_ eq '' ? q|scalar| : qq|($_)| }
$outer->[0], $inner->[0];
AFSMTS_method_wrap $method,
$outer->[1], q|Matt|, $wt, $mf, $inner->[0];
like $@,
qr.(?x)
\h\{Matt\}\(\{Tanya\}\):\h\{Pearl\}\hisa\h \($outer->[0]\),
\hshould\hbe\h\($inner->[0]\)\h.,
AFSMTS_croakson $tag }}}
# vim: set filetype=perl
t/process/sort.t view on Meta::CPAN
is_deeply \@input, $super, q|one item|;
$super = [qw| Keid Meissa |];
@inbase = ([ @$super ], [ reverse @$super ]);
while( @inbase ) {
AFSMTS_wrap;
is_deeply \@input, $super, q|two items| }
$super = [qw| Atik Keid Meissa |];
@inbase =
( map {; $_, do { my $rc = [ @$_ ]; push @$rc, shift @$rc; $rc }}
[ @$super ], [ reverse @$super ]);
while( @inbase ) {
AFSMTS_wrap;
is_deeply \@input, $super, q|three items| }
$super =
[qw| Algorab Ancha Atik Azha
Denebola Keid Meissa Rigil_Kentaurus
Scheat Skat |];
@inbase = ([ @$super ], [ reverse @$super ]);
t/state/break.t view on Meta::CPAN
[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]};
t/state/continue.t view on Meta::CPAN
[ q|[U](CONTINUE/NEXT)|,
[qw| todo eignore |],
{ CONTINUE =>
{ switch => \&AFSMTS_U, uturn => [qw| CONTINUE NEXT |]}} ],
[ q|[_](CONTINUE/NEXT)|,
[qw| todo eignore |],
{ CONTINUE =>
{ switch => \&AFSMTS_T,
turns => { 1 => [qw| CONTINUE NEXT |]}} } ] );
plan tests => 2 + scalar map {
( '' ) x ( 2 - grep( q|eignore| eq $_, @{$_->[1]})) } @data;
%st =
( START => { switch => sub { 1 }, tturn => [qw| workload |]},
workload =>
{ switch => \&AFSMTS_T,
eturn => [qw| BREAK bodine |],
tturn => [qw| BREAK godolphin |] },
BREAK => { switch => \&AFSMTS_T } );
AFSMTS_wrap;
t/state/start.t view on Meta::CPAN
{ 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;
AFSMTS_wrap;
unlike $@, qr<^ALRM>, AFSMTS_croakson qq|empty, $item->[0]| unless
grep $_ eq q|eignore|, @{$item->[1]};
toggle_now;
t/state/stop.t view on Meta::CPAN
[ 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
t/state/workload.t view on Meta::CPAN
[qw| push eignore |],
{ workload =>
{ switch => \&AFSMTS_F, fturn => [qw| MCXCIV NEXT MMMCDXXX |]}},
qr.\Q{MCXCIV}(): record !isa defined . ],
[ q|[U], trailing noise|,
[qw| push eignore |],
{ workload =>
{ switch => \&AFSMTS_U, uturn => [qw| DCCXLI NEXT MCDXLVII |]}},
qr.\Q{DCCXLI}(): record !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]};
my $res = ref $item->[3] eq q|ARRAY| ?
$item->[3] : [ $item->[3], $item->[3] ];
toggle_now;
AFSMTS_wrap;
is_deeply [ $@ =~ $res->[0], scalar @input ],
[ !0, 4 - grep $_ eq q|push|, @{$item->[1]} ],
( run in 1.175 second using v1.01-cache-2.11-cpan-49f99fa48dc )