view release on metacpan or search on metacpan
build_e7BB/Build_iu8t.pm view on Meta::CPAN
__PACKAGE__->add_property( q|buildq85v_files| => { } );
# FIXME:202502131915:whynot: Instead of B<add_build_element()> it should piggy-back on B<ACTION_docs()>. Too bad.
sub process_buildq85v_files {
my( $qrXNrk, $agxDOs ) = @_;
$agxDOs eq q|buildq85v| or die qq|!utOr! wrong target ($agxDOs)\n|;
# WORKAROUND:202502091853:whynot: Hard to imagine B<P::T> being missing, but that's one way to avoid to list it in I<%build_requires> (because C<buildq85v> isn't a target outside of development.
require Pod::Text or die qq|!wmvU! [require](Pod::Text) failed\n|;
# NOTE:202502091918:whynot: v3.17
my $qrSl5y = Pod::Text->new(
alt => !0, errors => q|stderr|, sentence => !0 );
my @lmGCWI;
while( my( $hprHQ0, $hqVg4r ) = each %{ $qrXNrk->buildq85v_files } ) {
my $hkTrsQ = ( stat $hprHQ0 )[9];
defined $hkTrsQ or die qq|!0lnO! [stat]($hprHQ0): $!\n|;
my $hkVGdJ = -e $hqVg4r ? ( stat $hqVg4r )[9] : 0;
defined $hkVGdJ or die qq|!R6ZO! [stat]($hqVg4r): $!\n|;
$hkTrsQ < $hkVGdJ and next;
open my $hpNrEp, q|<|, $hprHQ0 or die
qq|!nUAe! [open]($hprHQ0): $!\n|;
open my $hqrXZZ, q|>|, $hqVg4r or die
t/TestSuite.pm view on Meta::CPAN
Provides access to current build.
=cut
our $build = Module::Build->current;
=item I<$t::TestSuite::NO_TRIM>
$t::TestSuite::NO_TRIM = 1;
Forbids trimming I<$main::stderr>.
=cut
our $NO_TRIM;
=back
=cut
=head1 FUNCTIONS
t/TestSuite.pm view on Meta::CPAN
unless( Test::More::is_deeply(
[ $main::rc, $got ], $expected, $descr )) {
AFSMTS_diag sprintf qq| at %s line %i.|, ( caller )[1,2];
AFSMTS_dump [ $main::rc ];
AFSMTS_dump [ $got ] }}
=item B<AFSMTS_wrap()>
use t::TestSuite qw/ :run /;
our( $rc, %st, $bb, %opts );
our( $stdout, $stderr );
AFSMTS_wrap;
AFSMTS_deeply @{[ ]}, 'again!';
TODO: {
local TODO = 'oops, not yet';
AFSMTS_wrap;
isnt $rc, "ALRM\n", 'success!';
}
t/TestSuite.pm view on Meta::CPAN
An object is reZ<>B<connect>ed;
I<$bb{queue}> is created and set to empty ARRAY.
=item I<%opts>
A hash of options, those will be passed to constructor.
=back
I<STDOUT> and I<STDERR> are backed up in scalars;
those are saved in I<$main::stdout> and I<$main::stderr>.
I<STDERR> is output with B<AFSMTS_diag()> anyway.
However, it's trimmed to first 1024 bytes
(unless I<$t::TestSuite::NO_TRIM> is TRUE)
(it's not clear yet if those are 1024 bytes or characters).
Also, there's a timeout feature.
That timeout should be protected with TODO of B<Test::More>.
I<STDERR> is dumped too.
That timeout is implemented with B<alarm>ed B<eval>.
That B<eval> protects against B<die>s too.
=cut
sub AFSMTS_wrap ( ) {
open my $stdout_bak, q|>&|, \*STDOUT;
open my $stderr_bak, q|>&|, \*STDERR;
close STDOUT; open STDOUT, q|>|, \$main::stdout;
close STDERR; open STDERR, q|>|, \$main::stderr;
local $SIG{__DIE__} = sub {
alarm 0;
close STDOUT; open STDOUT, q|>&|, $stdout_bak;
close STDERR;
open STDERR, q|>&|, $stderr_bak };
do {
no warnings qw| once |;
$main::bb = Acme::FSM->connect( { %main::opts }, \%main::st ) };
$main::bb->{queue} = [ ];
my $rc = [ eval {
local $SIG{ALRM} = sub { die qq|ALRM\n| };
alarm 3;
$main::rc = [ $main::bb->process ];
alarm 0;
1 } ];
unless( @$rc ) {
# TODO:20121120224141:whynot: Make sure it's 1024 characters not bytes.
$main::stderr = substr $main::stderr || '', 0, 1024 unless $NO_TRIM;
$main::rc = [ $@ ] }
close STDERR; open STDERR, q|>&|, $stderr_bak;
close STDOUT; open STDOUT, q|>&|, $stdout_bak;
AFSMTS_diag $main::stderr }
=item B<AFSMTS_class_wrap()>
use t::Test::Suite qw/ :wraps /;
our( $rc, %st, $bb );
our( $stdout, $stderr );
AFSMTS_class_wrap @list;
Complete analogy of B<AFSMTS_wrap()> except B<process()> isn't called and
there's no timeout protection.
Also, there's I<$t::TestSuite::class_cheat>, what, if B<defined> is supposed
to be class name of B<A::F> descandant.
=cut
our $class_cheat;
sub AFSMTS_class_wrap ( @ ) {
open my $stdout_bak, q|>&|, \*STDOUT;
open my $stderr_bak, q|>&|, \*STDERR;
close STDOUT; open STDOUT, q|>|, \$main::stdout;
close STDERR; open STDERR, q|>|, \$main::stderr;
local $SIG{__DIE__} = sub {
close STDOUT; open STDOUT, q|>&|, $stdout_bak;
close STDERR; open STDERR, q|>&|, $stderr_bak;
AFSMTS_diag $main::stderr };
$main::bb = $class_cheat ?
eval qq|${class_cheat}->connect( \@_ )| :
Acme::FSM->connect( @_ );
close STDERR; open STDERR, q|>&|, $stderr_bak;
close STDOUT; open STDOUT, q|>&|, $stdout_bak;
AFSMTS_diag $main::stderr }
=item B<AFSMTS_object_wrap()>
use t::TestSuite qw/ :wraps /;
our( $rc, %st, $bb );
our( $stdout, $stderr );
AFSMTS_object_wrap $childof_A_F, @list;
Complete analogy of B<AFSMTS_wrap()> except B<process()> isn't called and
there's no timeout protection.
It's different from B<AFSMTS_class_wrap> that it goes with
object-construction.
That object goes as a first parameter, then comes list of items to process.
=cut
sub AFSMTS_object_wrap ( $@ ) {
my $obj = shift @_;
open my $stdout_bak, q|>&|, \*STDOUT;
open my $stderr_bak, q|>&|, \*STDERR;
close STDOUT; open STDOUT, q|>|, \$main::stdout;
close STDERR; open STDERR, q|>|, \$main::stderr;
local $SIG{__DIE__} = sub {
close STDOUT; open STDOUT, q|>&|, $stdout_bak;
close STDERR; open STDERR, q|>&|, $stderr_bak;
AFSMTS_diag $main::stderr };
$main::bb = $obj->connect( @_ );
close STDERR; open STDERR, q|>&|, $stderr_bak;
close STDOUT; open STDOUT, q|>&|, $stdout_bak;
AFSMTS_diag $main::stderr }
=item B<AFSMTS_method_wrap()>
use t::TestSuite qw/ :wraps /;
our( $rc, %st, $bb );
our( $stdout, $stderr );
AFSMTS_method_wrap 'some_method', @list;
Complete analogy of B<AFSMTS_wrap()> except instead of B<process()> some
requested I<$method> is B<can>ed first, than invoked with I<@list> over
I<$main::bb> in list context.
What is returned is placed in I<$main::rc> wrapped in ARRAY.
If I<$method> returned one element then ARRAY is replaced with scalar.
=cut
sub AFSMTS_method_wrap ( $@ ) {
open my $stdout_bak, q|>&|, \*STDOUT;
open my $stderr_bak, q|>&|, \*STDERR;
close STDOUT; open STDOUT, q|>|, \$main::stdout;
close STDERR; open STDERR, q|>|, \$main::stderr;
my $method = $main::bb->can( shift @_ );
my $rc = [ eval {
local $SIG{ALRM} = sub { die qq|ALRM\n| };
alarm 3;
$main::rc = [ $main::bb->$method( @_ ) ];
alarm 0;
1 } ];
alarm 0;
unless( @$rc ) {
$main::stderr = substr $main::stderr // '', 0, 1024 unless $NO_TRIM;
$main::rc = [ $@ ] }
$main::rc = $main::rc->[0] if 1 == @$main::rc;
close STDERR; open STDERR, q|>&|, $stderr_bak;
close STDOUT; open STDOUT, q|>&|, $stdout_bak;
AFSMTS_diag $main::stderr }
=item B<AFSMTS_croakson> 'actual description'
use t::TestSuite qw/ :diag /;
$rc = eval { die 'as expected'; 1 };
is !$rc, 0, AFSMTS_croakson 'surprise';
That will add I<$@> (with newlines replaced with spaces) to otherwise dumb
description, like this:
t/action/next.t view on Meta::CPAN
use warnings;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );
use t::TestSuite qw| :run :diag |;
use Test::More tests => 41;
use Acme::FSM;
our( %st, $rc, %opts, $stderr );
our @inbase = ( undef,
q|DEATH|, undef,
qw| Famine Satan |, undef,
qw| ADAM Ligur God |, undef,
qw| Shadwell Brian War Wensleydale |, undef );
our @input = @inbase;
$opts{source} = \&AFSMTS_shift;
my $tag;
my %common =
t/action/same.t view on Meta::CPAN
package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );
use t::TestSuite qw| :run :diag |;
use Test::More;
plan tests => 41;
use Acme::FSM;
our( %st, $rc, %opts, $stderr );
our @inbase = ( undef,
q|Kraljevo|, undef,
qw| Seattle Charlottesvill |, undef,
qw| Malaysia Marseille LasVegas |, undef,
qw| Purdue Women Pittsburgh Sonoma |, undef );
our @input = @inbase;
$opts{source} = \&AFSMTS_shift;
my $tag;
my %common =
t/action/tstl.t view on Meta::CPAN
package main;
use version 0.77; our $VERSION = version->declare( v2.2.5 );
use t::TestSuite qw| :run :diag |;
use Test::More;
plan tests => 41;
use Acme::FSM;
our( %st, $rc, %opts, $stderr );
our @inbase = ( undef,
q|Adams|, undef,
qw| Roosevelt Hayes |, undef,
qw| Jefferson Harrison Johnson |, undef,
qw| Buchanan Bush Lincoln Carter |, undef );
our @input = @inbase;
$opts{source} = \&AFSMTS_shift;
my $tag;
my %common =
t/base/action.t view on Meta::CPAN
use parent q|Acme::FSM|;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.1 );
use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 14;
use Acme::FSM;
our( $bb, $rc, $stderr );
my $method = q|action|;
my( $old, $new ) = qw| VOID champagne |;
AFSMTS_class_wrap { diag_level => 10 };
isa_ok $bb, q|Acme::FSM|, q|constructed object|;
is $bb->{_}{action}, $old, qq|initial {action} isa ($old)|;
my $tag = q|no args,|;
AFSMTS_method_wrap $method;
is $rc, $old, qq|$tag {action} is returned|;
is $bb->{_}{action}, $old, qq|$tag correct|;
$tag = q|one arg,|;
AFSMTS_method_wrap $method, $new;
is $bb->{_}{action}, $new, qq|$tag new {action} is set|;
is $rc, $old, qq|$tag old {action} is returned|;
like $stderr, qr<(?m)^\Q[action]: changing action: ($old) ($new)>,
qq|$tag noted|;
$tag = q|other arg,|;
( $old, $new ) = ( $new, q|ale| );
AFSMTS_method_wrap $method, $new;
is $bb->{_}{action}, $new, qq|$tag new {action} is set again|;
is $rc, $old, qq|$tag old {action} is returned again|;
like $stderr, qr<(?m)^\Q[action]: changing action: ($old) ($new)>,
qq|$tag noted|;
$tag = q|two args,|;
AFSMTS_method_wrap $method, qw| rum porter |;
is $bb->{_}{action}, $new, qq|$tag old {action} stays|;
ok !defined $rc, qq|$tag ((undef)) is returned|;
like $stderr, qr<(?m)^\Q[action]: too many args (2) >, qq|$tag noted|;
AFSMTS_method_wrap $method;
is $rc, $new, qq|$tag {action} stays|;
# vim: set filetype=perl
t/base/carp.t view on Meta::CPAN
use parent q|Acme::FSM|;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.2 );
use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 6;
use Acme::FSM;
our( $bb, $stderr );
my $method = q|carp|;
AFSMTS_class_wrap { diag_level => 10 };
isa_ok $bb, q|Acme::FSM|, q|constructed object|;
my $tag = q|no args,|;
AFSMTS_method_wrap $method;
unlike $stderr, qr{(?m)^Use of uninitialized value\V+Acme/FSM\V+$},
qq|$tag no UOUV warning|;
like $stderr, qr{(?m)^\[\(eval\)\]:\h+at t/TestSuite\.pm\V+$},
qq|$tag noted|;
$tag = q|one arg,|;
AFSMTS_method_wrap $method, q|deer|;
like $stderr, qr{(?m)\V+: deer at \V+}, qq|$tag noted|;
$tag = q|two args,|;
AFSMTS_method_wrap $method, qw| moose alces_alces |;
like $stderr, qr{(?m)^\V+: moosealces_alces at \V+$}, qq|$tag noted|;
$tag = q|trimmed {diag_level}|;
AFSMTS_object_wrap $bb, { diag_level => 0 };
AFSMTS_method_wrap $method;
is $stderr, '', qq|$tag obeyed|;
# vim: set filetype=perl
t/base/connect.t view on Meta::CPAN
use parent q|Acme::FSM|;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.1 );
use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 54;
use Acme::FSM;
our( $bb, $bback, $stderr );
$bb = eval { AFSMTS_class_wrap; 1 };
ok !$bb && $@ =~ m<{options} HASH is required>,
AFSMTS_croakson q|class, no {options}|;
my %common =
( fst => { },
state => q|START|,
action => q|VOID|,
diag_level => 10,
namespace => undef,
source => undef,
dumper => undef );
my $tag = q|class, empty {options},|;
AFSMTS_class_wrap { };
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, diag_level => 1 }, qq|$tag init done|;
like $stderr, qr<(?m)^\Q[connect]: FST has no {START} state>,
qq|$tag no {START} noted|;
like $stderr, qr<(?m)^\Q[connect]: FST has no {STOP} state>,
qq|$tag no {STOP} noted|;
$bback = $bb;
undef $bb;
$bb = eval { AFSMTS_object_wrap $bback; 1 };
ok !$bb && $@ =~ m<{options} HASH is required>,
AFSMTS_croakson q|object, no {options}|;
$tag = q|object, empty {options},|;
AFSMTS_object_wrap $bback, { };
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, diag_level => 1 }, qq|$tag init done|;
like $stderr, qr<(?m)^\Q[connect]: FST has no {START} state>,
qq|$tag no {START} noted|;
like $stderr, qr<(?m)^\Q[connect]: FST has no {STOP} state>,
qq|$tag no {STOP} noted|;
is_deeply
[ $bb->{_}{fst}, $bb->{_} ne $bback->{_} ], [ $bback->{_}{fst}, !0 ],
qq|$tag {fst} check|;
$tag = q|class, minimal FST explicitly in {@_},|;
AFSMTS_class_wrap { diag_level => 10 }, qw| START splat STOP tic_tac_toe |;
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, fst => {qw| START splat STOP tic_tac_toe |}},
qq|$tag init done|;
like $stderr, qr<(?m)^\Q[connect]: clean init with (2) >,
qq|$tag items in FST noted|;
$bback = $bb;
$tag = q|object, minimal FST explicity in {@_},|;
AFSMTS_object_wrap $bback, { }, qw| START hash_mark STOP pound_sign |;
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, fst => {qw| START splat STOP tic_tac_toe |}},
qq|$tag init done|;
is_deeply
[ $bb->{_}{fst}, $bb->{_} ne $bback->{_} ], [ $bback->{_}{fst}, !0 ],
qq|$tag {fst} check|;
like $stderr, qr<(?m)^\Q[connect]: stealing (2) >,
qq|$tag items in FST noted|;
like $stderr, qr<(?m)^\Q[connect]: ignoring (4) >,
qq|$tag items in trailer noted|;
$tag = q|class, minimal FST in HASH,|;
my $fsta = {qw| START flash STOP thump |};
AFSMTS_class_wrap { diag_level => 10 }, $fsta;
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, fst => { %$fsta }}, qq|$tag init done|;
is $bb->{_}{fst}, $fsta, qq|$tag {fst} isa prepared HASH|;
like $stderr, qr<(?m)^\Q[connect]: clean init with (2) >,
qq|$tag items in FST noted|;
$bback = $bb;
$tag = q|object, minimal FST in HASH,|;
my $fstb = {qw| START thud STOP sharp |};
AFSMTS_object_wrap $bback, { }, $fstb;
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, fst => { %$fsta }}, qq|$tag init done|;
is_deeply
[ $bb->{_}{fst}, $bb->{_} ne $bback->{_}, $bb->{_}{fst} ],
[ $bback->{_}{fst}, !0, $fsta ],
qq|$tag {fst} check|;
like $stderr, qr<(?m)^\Q[connect]: stealing (2) >,
qq|$tag items in FST noted|;
like $stderr, qr<(?m)^\Q[connect]: ignoring (2) >,
qq|$tag items in trailer noted|;
$tag = q|class, minimal FST in HASH, minimal trailer,|;
$fsta = {qw| START mesh STOP crosshatch |};
AFSMTS_class_wrap { diag_level => 10 }, $fsta, hex => q|octalthorpe|;
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, fst => { %$fsta }}, qq|$tag init done|;
is $bb->{_}{fst}, $fsta, qq|$tag {fst} isa prepared HASH|;
like $stderr, qr<(?m)^\Q[connect]: clean init with (2) >,
qq|$tag items in FST noted|;
like $stderr, qr<(?m)^\Q[connect]: ignoring (2) >,
qq|$tag items in trailer noted|;
$bback = $bb;
$tag = q|object, minimal FST in HASH, minimal trailer,|;
$fstb = {qw| START octothorn STOP crunch |};
AFSMTS_object_wrap $bback, { }, $fstb, noughts_and_crosses => q|widget_mark|;
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, fst => { %$fsta }}, qq|$tag init done|;
is $bb->{_}{fst}, $fsta, qq|$tag {fst} isa prepared HASH|;
like $stderr, qr<(?m)^\Q[connect]: stealing (2) >,
qq|$tag items in FST noted|;
like $stderr, qr<(?m)^\Q[connect]: ignoring (2) >,
qq|$tag items in traler noted|;
$t::TestSuite::class_cheat = q|t::TestSuite::FSM|;
$tag = q|just checking,|;
$fsta = {qw| START pig_pen STOP comment_sign |};
AFSMTS_class_wrap { }, $fsta;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag processed|;
$bback = $bb;
$tag = q|object, inheritance,|;
AFSMTS_object_wrap $bback, { };
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag processed|;
undef $t::TestSuite::class_cheat;
$tag = q|class, unknown {options},|;
AFSMTS_class_wrap { diag_level => 10, noughts_and_crosses => q|octothorpe| };
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common }, qq|$tag init done|;
like $stderr, qr<(?m)^\Q[connect]: (noughts_and_crosses): unknown option>,
qq|$tag noted|;
$bback = $bb;
$tag = q|object, unknown {options},|;
AFSMTS_object_wrap $bback, { hex => q|gate| };
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common }, qq|$tag init done|;
like $stderr, qr<(?m)^\Q[connect]: (hex): unknown option>, qq|$tag noted|;
$tag = q|class, {options}{namespace},|;
AFSMTS_class_wrap { diag_level => 10, namespace => q|gate| };
isa_ok $bb, q|Acme::FSM|, qq|$tag processed|;
is_deeply $bb->{_}, { %common, namespace => q|gate| },
qq|$tag {namespace} accepted|;
$bback = $bb;
$tag = q|object, {options}{namespace}, get from source,|;
AFSMTS_object_wrap $bback, { };
t/base/diag.t view on Meta::CPAN
use warnings;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.4 );
use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 25;
use Acme::FSM;
our( $bb, $stderr );
my $method = q|diag|;
AFSMTS_class_wrap { diag_level => 10 };
isa_ok $bb, q|Acme::FSM|, q|constructed object|;
my $tag = q|no args,|;
AFSMTS_method_wrap $method;
like $stderr, qr{(?m)^Use of uninitialized value in numeric\V+Acme/FSM\V+$},
qq|$tag UOUV in level check|;
like $stderr, qr{(?m)^Use of uninitialized value in sprintf\V+Acme/FSM\V+$},
qq|$tag UOUV in sprintf|;
like $stderr, qr{(?m)^\[\(eval\)\]: $}, qq|$tag noted|;
$tag = q|limit isn't numeric,|;
AFSMTS_method_wrap $method, q|northwest|;
like $stderr, qr{(?m)"northwest" isn't numeric in numeric\V+Acme/FSM\V+$},
qq|$tag ININ in level check|;
like $stderr, qr{(?m)^Use of uninitialized value in sprintf\V+Acme/FSM\V+$},
qq|$tag UOUV in sprintf|;
like $stderr, qr{(?m)^\[\(eval\)\]: $}, qq|$tag noted|;
$tag = q|no format,|;
AFSMTS_method_wrap $method, 9;
unlike $stderr, qr{(?m)\V+ in numeric\V+Acme/FSM\V+$},
qq|$tag no ININ in level check|;
like $stderr, qr{(?m)^Use of uninitialized value in sprintf\V+Acme/FSM\V+$},
qq|$tag UOUV in sprintf|;
like $stderr, qr{(?m)^\[\(eval\)\]: $}, qq|$tag noted|;
$tag = q|format, no conversion,|;
AFSMTS_method_wrap $method, 9, q|south|;
unlike $stderr, qr{(?m)\V+Acme/FSM\V+$}, qq|$tag no warnings|;
like $stderr, qr{(?m)^\[\(eval\)\]: south$}, qq|$tag noted|;
$tag = q|format, conversion, no paramter,|;
AFSMTS_method_wrap $method, 9, q|%s|;
like $stderr, qr{(?m)^Missing argument in printf\V+Acme/FSM\V+$},
qq|$tag MAI printf|;
like $stderr, qr{(?m)^\[\(eval\)\]: $}, qq|$tag noted|;
$tag = q|format, conversion, paramter,|;
AFSMTS_method_wrap $method, 9, q|%s|, q|southwest|;
unlike $stderr, qr{(?m)\V+Acme/FSM\V+$}, qq|$tag no warnings|;
like $stderr, qr{(?m)^\[\(eval\)\]: southwest$}, qq|$tag noted|;
$tag = q|format, conversion, extra paramter,|;
AFSMTS_method_wrap $method, 9, q|%s|, qw| east west |;
TODO: {
local $TODO = q|not enabling C<no warnings "redundant">|;
like $stderr, qr{(?m)\V+Acme/FSM\V+$}, qq|$tag no warnings| }
like $stderr, qr{(?m)^\[\(eval\)\]: east$}, qq|$tag noted|;
my @in = qw| Narrator Tinky_Winky Baby_Sun Po Trumpets Noo_Noo Dipsy |;
my @data =
([qw| Narrator |],
[qw| Narrator Tinky_Winky |],
[qw| Narrator Tinky_Winky Baby_Sun |],
[qw| Narrator Tinky_Winky Baby_Sun Po |],
[qw| Narrator Tinky_Winky Baby_Sun Po Trumpets |],
[qw| Narrator Tinky_Winky Baby_Sun Po Trumpets Noo_Noo |],
[qw| Narrator Tinky_Winky Baby_Sun Po Trumpets Noo_Noo Dipsy |] );
foreach my $level ( 0 .. 6 ) {
my @out;
AFSMTS_object_wrap $bb, { diag_level => $level };
foreach my $diag ( 0 .. 6 ) {
AFSMTS_method_wrap $method, $diag, $in[$diag];
push @out, $in[$diag] if
$stderr }
is_deeply [ @out ], $data[$level], qq|respects {diag_level} ($level)| }
# vim: set filetype=perl
t/base/fst.t view on Meta::CPAN
use warnings;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );
use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 43;
use Acme::FSM;
our( $bb, $rc, $stderr );
my $method = q|fst|;
my( $fste, $fsto ) = qw| lobster beans |;
my( $old, $new, $deep, $late ) = qw| entwistle barry boeblich fazzo |;
my $tag;
AFSMTS_class_wrap { diag_level => 10 };
isa_ok $bb, q|Acme::FSM|, q|constructed object|;
ok !keys %{$bb->{_}{fst}}, qq|initial {fst} isa empty|;
$tag = q|no args, no fste,|;
AFSMTS_method_wrap $method;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 0, undef ],
qq|$tag queried|;
like $stderr, qr<(?m)^\Q[fst]: no args >, qq|$tag noted|;
$tag = q|one arg, fste isa unset,|;
AFSMTS_method_wrap $method, $fste;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 0, undef ],
qq|$tag queried|;
like $stderr, qr<(?m)^\Q[fst]: ($fste): no such {fst} record>, qq|$tag noted|;
$tag = q|two args (SCALAR), fste isa unset,|;
AFSMTS_method_wrap $method, $fste => $old;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 0, undef ],
qq|$tag queried|;
like $stderr, qr<(?m)^\Q[fst]: ($fste): no such {fst} record>, qq|$tag noted|;
$tag = q|three args, fste isa unset,|;
AFSMTS_method_wrap $method, $fste => $old => $deep;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 0, undef ],
qq|$tag queried|;
like $stderr, qr<(?m)^\Q[fst]: ($fste): no such {fst} record>, qq|$tag noted|;
$tag = q|two args (HASH), fste isa unset,|;
my $elder = { $old => $late };
AFSMTS_method_wrap $method, $fste => $elder;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 1, undef ],
qq|$tag queried|;
ok exists $bb->{_}{fst}{$fste}, qq|$tag {fst} is indeed updated|;
is_deeply $bb->{_}{fst}{$fste}, { %$elder },
qq|$tag just created entry is correct|;
isnt $bb->{_}{fst}{$fste}, $elder, qq|$tag just created entry is copied|;
like $stderr, qr<(?m)^\Q[fst]: creating {$fste} >, qq|$tag noted|;
$tag = q|one arg, fste is set,|;
AFSMTS_method_wrap $method, $fste;
is_deeply
[ scalar keys %{$bb->{_}{fst}}, qq|$rc| ], [ 1, qq|$bb->{_}{fst}{$fste}| ],
qq|$tag queried|;
is_deeply $rc, $elder, qq|$tag {fst} entry is returned|;
$tag = q|two args (SCALAR), fste is set, known key,|;
AFSMTS_method_wrap $method, $fste => $old;
t/base/fst.t view on Meta::CPAN
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 1, undef ],
qq|$tag queried|;
is_deeply $bb->{_}{fst}{$fste}, $elder, qq|$tag {fst} entry stays intact|;
$tag = q|three args, fste is set, known key,|;
$elder->{$old} = $deep;
AFSMTS_method_wrap $method, $fste => $old => $deep;
is_deeply [ scalar keys %{$bb->{_}{fst}}, qq|$rc| ], [ 1, qq|$late| ],
qq|$tag queried|;
is_deeply $bb->{_}{fst}{$fste}, $elder, qq|$tag {fst} entry is updated|;
like $stderr, qr<(?m)^\Q[fst]: updating {$fste}{$old} >, qq|$tag noted|;
AFSMTS_method_wrap $method, $fste;
is_deeply $rc, $elder, qq|$tag indeed it is|;
$tag = q|three args, fste is set, unknown key,|;
$elder->{$new} = $deep = q|fauchard|;
AFSMTS_method_wrap $method, $fste => $new => $deep;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 1, undef ],
qq|$tag queried|;
is_deeply $bb->{_}{fst}{$fste}, $elder, qq|$tag {fst} entry is updated|;
like $stderr, qr<(?m)^\Q[fst]: creating {$fste}{$new} >, qq|$tag noted|;
AFSMTS_method_wrap $method, $fste;
is_deeply $rc, $elder, qq|$tag indeed it is|;
$tag = q|three args, fste is set, duplicate value,|;
$elder->{$new} = $late;
AFSMTS_method_wrap $method, $fste => $new => $late;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 1, $deep ],
qq|$tag queried|;
is_deeply $bb->{_}{fst}{$fste}, $elder, qq|$tag {fst} entry is updated|;
like $stderr, qr<(?m)^\Q[fst]: updating {$fste}{$new} >, qq|$tag noted|;
AFSMTS_method_wrap $method, $fste;
is_deeply $rc, $elder, qq|$tag indeed it is|;
$tag = q|two args (HASH), other fste isa unset,|;
( $old, $late ) = qw| billy lazar |;
my $youngster = { $old => $late };
AFSMTS_method_wrap $method, $fsto => $youngster;
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], [ 2, undef ],
qq|$tag queried|;
ok exists $bb->{_}{fst}{$fsto}, qq|$tag {fst} is indeed updated|;
is_deeply $bb->{_}{fst}{$fsto}, { %$youngster },
qq|$tag just created entry is correct|;
isnt $bb->{_}{fst}{$fsto}, $youngster, qq|$tag just created entry is copied|;
like $stderr, qr<(?m)^\Q[fst]: creating {$fsto} >, qq|$tag noted|;
AFSMTS_method_wrap $method, $fste;
is_deeply $rc, $elder, qq|$tag other {fst} isn't affected|;
$tag = q|four args,|;
AFSMTS_method_wrap $method, qw| beans billy lazar contango |;
like $stderr, qr<(?m)^\Q[fst]: too many args (4)>, qq|$tag noted|;
is scalar keys %{$bb->{_}{fst}}, 2, qq|$tag {fst} is intact|;
AFSMTS_method_wrap $method, $fste;
is_deeply $rc, $elder, qq|$tag first {fst} isn't affected|;
AFSMTS_method_wrap $method, $fsto;
is_deeply $rc, $youngster, qq|$tag second {fst} isn't affected|;
# vim: set filetype=perl
t/base/query.t view on Meta::CPAN
shift @main::flags }
package main;
use version 0.77; our $VERSION = version->declare( v2.3.2 );
use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 45;
use Acme::FSM;
our( $bb, $rc, $stderr );
our %st = ( );
my $method = q|query|;
our @flags =
qw| The_Night_We_Died Zaia
Muh Ka_III
Zombies De_Zeuhl_Undazir
Eliphas_Levi Maneh_Fur_Da_Zess
Troller_Tanz Ek_Sun_Da_Zess
C_est_la_Vie_Qui_les_A_Menes_La Nono
t/base/query.t view on Meta::CPAN
$tag = q|{havoc} isa (Acme::FSM),|;
AFSMTS_method_wrap $method, $bb, $mf;
like $@, qr.\Q {havoc} isa (Acme::FSM)., AFSMTS_croakson $tag;
$tag = q|{havoc} isa (CODE), {namespace} unset,|;
AFSMTS_method_wrap $method, \&t::TestSuite::FSM::shift_shift, $mf;
is_deeply
[ $bb->{bull}, exists $bb->{shambles}, $rc ],
[ q|The_Night_We_Died|, '', q|Zaia| ],
qq|$tag queried|;
like $stderr, qr.(?m)\Q[(eval)]: {havoc} isa (CODE).,
qq|$tag noted|;
$tag = q|{havoc} isa (CODE), {namespace} unset, argument isa set,|;
AFSMTS_method_wrap $method,
\&t::TestSuite::FSM::shift_shift, $mf, q|Fur_Dihhel_Kobaia|;
is_deeply
[@$bb{qw| bull shambles |}, $rc ], [qw| Muh Fur_Dihhel_Kobaia Ka_III |],
qq|$tag queried|;
like $stderr, qr.(?m)\Q[(eval)]: {havoc} isa (CODE).,
qq|$tag noted|;
$tag = q|{havoc} isa (CODE), {namespace} isa set,|;
AFSMTS_class_wrap { %plug, namespace => q|swill| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, \&t::TestSuite::FSM::shift_shift, $mf;
is_deeply
[ $bb->{bull}, exists $bb->{shambles}, $rc ],
[ q|Zombies|, '', q|De_Zeuhl_Undazir| ],
qq|$tag queried|;
like $stderr, qr.(?m)\Q[(eval)]: {havoc} isa (CODE).,
qq|$tag noted|;
$tag = q|{havoc} isa (CODE), {namespace} isa set, argument isa set,|;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, \&t::TestSuite::FSM::shift_shift, $mf, q|Hhai|;
is_deeply
[@$bb{qw| bull shambles |}, $rc ],
[qw| Eliphas_Levi Hhai Maneh_Fur_Da_Zess |],
qq|$tag queried|;
like $stderr, qr.(?m)\Q[(eval)]: {havoc} isa (CODE).,
qq|$tag noted|;
$tag = q|{havoc} isa (), {namespace} !isa defined,|;
AFSMTS_class_wrap { %plug }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|junk|, $mf;
like $@, qr.\Q {namespace} !isa defined., AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[(eval)]: {havoc} isa ()., qq|$tag noted|;
$tag = q|{havoc} !isa defined method, {namespace} eq (),|;
$t::TestSuite::class_cheat = q|t::TestSuite::FSM|;
AFSMTS_class_wrap { %plug, namespace => '' }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|tfihs_tfihs|, $mf;
like $@, qr.\Q <t::TestSuite::FSM> can't [tfihs_tfihs] method .,
AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[(eval)]: defaulting {havoc} to \E\x24self.,
qq|$tag defaulting noted|;
like $stderr, qr.(?m)\Q[(eval)]: {namespace} isa (t::TestSuite::FSM).,
qq|$tag defaulted noted|;
$tag = q|{havoc} isa defined method, {namespace} eq (),|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf;
is_deeply
[ $bb->{bull}, exists $bb->{shambles}, $rc ],
[ q|Troller_Tanz|, '', q|Ek_Sun_Da_Zess| ],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[(eval)]: going for <t::TestSuite::FSM>->[shift_shift].,
qq|$tag noted|;
$tag = q|{havoc} isa defined method, {namespace} eq (), argument is set,|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf, q|Coltrane_Sundia|;
is_deeply
[@$bb{qw| bull shambles |}, $rc ],
[qw| C_est_la_Vie_Qui_les_A_Menes_La Coltrane_Sundia Nono |],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[(eval)]: going for <t::TestSuite::FSM>->[shift_shift].,
qq|$tag noted|;
$tag =
q|{havoc} !isa defined method, {namespace} eq (t::TestSuite::havoc),|;
my $havoc = t::TestSuite::havoc->new;
undef $t::TestSuite::class_cheat;
AFSMTS_class_wrap { %plug, namespace => $havoc }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|tfihs_tfihs|, $mf;
like $@, qr.\Q <t::TestSuite::havoc> can't [tfihs_tfihs] method .,
AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[(eval)]: defaulting {havoc} to \E\x24self.,
qq|$tag no defaulting|;
like $stderr, qr.(?m)\Q[(eval)]: {namespace} isa (t::TestSuite::havoc).,
qq|$tag {namespace} noted|;
$tag = q|{havoc} isa defined method, {namespace} eq (t::TestSuite::havoc),|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf;
is_deeply
[ $havoc->{mess}, exists $bb->{bull}, $rc ],
[ q|Do_The_Music|, '', q|Da_Zeuhl_Worts_Mekanik| ],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[(eval)]: going for <t::TestSuite::havoc>->[shift_shift].,
qq|$tag noted|;
$tag =
q|{havoc} isa defined method, {namespace} eq (t::TestSuite::havoc), | .
q|argument is set,|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf, q|Kohntark|;
is_deeply [@$havoc{qw| mess slops |}, $rc ], [qw| Thaud Kohntark Wainsaht |],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[(eval)]: going for <t::TestSuite::havoc>->[shift_shift].,
qq|$tag noted|;
$tag =
q|{havoc} !isa defined subroutine, {namespace} eq (t::TestSuite::havoc),|;
AFSMTS_class_wrap { %plug, namespace => q|t::TestSuite::havoc| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|tfihs_tfihs|, $mf;
like $@,
qr.(?m)\Q[(eval)]: <t::TestSuite::havoc> package can't [tfihs_tfihs].,
AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[(eval)]: defaulting {havoc} to \E\x24self.,
qq|$tag no defaulting|;
like $stderr, qr.(?m)\Q[(eval)]: {namespace} isa ().,
qq|$tag {namespace} isa scalar|;
$tag =
q|{havoc} isa defined subroutine, {namespace} eq (t::TestSuite::havoc),|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf;
is_deeply
[ $bb->{mess}, exists $bb->{bull}, $rc ],
[ q|The_Last_Seven_Minutes|, '', q|Nebehr_Gudahtt| ],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[(eval)]: going for <t::TestSuite::havoc>::[shift_shift].,
qq|$tag noted|;
$tag =
q|{havoc} isa defined subroutine, {namespace} eq (t::TestSuite::havoc), | .
q|argument is set,|;
AFSMTS_method_wrap $method, q|shift_shift|, $mf, q|Ka_I|;
is_deeply [@$bb{qw| mess slops |}, $rc ], [qw| Udu_Wudu Ka_I Kohntarkosz |],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[(eval)]: going for <t::TestSuite::havoc>::[shift_shift].,
qq|$tag noted|;
$tag = q|{havoc} returns empty,|;
AFSMTS_class_wrap { }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, sub { }, $mf;
is_deeply $rc, [ ], qq|$tag queried|;
$tag = q|{havoc} returns one item, item isa scalar|;
t/base/query_dumper.t view on Meta::CPAN
shift @main::flags }
package main;
use version 0.77; our $VERSION = version->declare( v2.3.2 );
use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 65;
use Acme::FSM;
our( %st, $bb, $rc, $stderr );
our @flags =
qw| Orcrist Brinning
Nothung Gurthang
Caliburn Mimun
Durandal Graban
Ekkisax Noralltach
Claidheamh_Solius Samsamha
Baptism Galatyn
Murgleis Haute_Claire
Waske Courtain
t/base/query_dumper.t view on Meta::CPAN
like $@, qr.\Q {dumper} isa (Acme::FSM)., AFSMTS_croakson $tag;
$tag = q|{dumper} isa (CODE), {namespace} unset,|;
AFSMTS_class_wrap { %plug, dumper => \&t::TestSuite::FSM::shift_shift }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{matrixone}, exists $bb->{CSSC}, $rc ],
[ q|Orcrist|, '', q|Brinning| ],
qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_dumper]: {dumper} isa (CODE)., qq|$tag noted|;
$tag = q|{dumper} isa (CODE), {namespace} unset, argument isa set,|;
AFSMTS_class_wrap { %plug, dumper => \&t::TestSuite::FSM::shift_shift }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Dyrnwyn|;
is_deeply
[@$bb{qw| matrixone CSSC |}, $rc ], [qw| Nothung Dyrnwyn Gurthang |],
qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_dumper]: {dumper} isa (CODE)., qq|$tag noted|;
$tag = q|{dumper} isa (CODE), {namespace} isa set,|;
AFSMTS_class_wrap
{ %plug,
namespace => q|Subversion|,
dumper => \&t::TestSuite::FSM::shift_shift },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{matrixone}, exists $bb->{CSSC}, $rc ], [ q|Caliburn|, '', q|Mimun| ],
qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_dumper]: {dumper} isa (CODE)., qq|$tag noted|;
$tag = q|{dumper} isa (CODE), {namespace} isa set, argument isa set,|;
AFSMTS_class_wrap
{ %plug, namespace => q|vesta|, dumper => \&t::TestSuite::FSM::shift_shift },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Merveilleuse|;
is_deeply
[@$bb{qw| matrixone CSSC |}, $rc ], [qw| Durandal Merveilleuse Graban |],
qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_dumper]: {dumper} isa (CODE)., qq|$tag noted|;
$tag = q|{dumper} isa (), {namespace} !isa defined,|;
AFSMTS_class_wrap { %plug, dumper => q|projector| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q {namespace} !isa defined., AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[query_dumper]: {dumper} isa ()., qq|$tag noted|;
$tag = q|{dumper} !isa defined method, {namespace} eq (),|;
$t::TestSuite::class_cheat = q|t::TestSuite::FSM|;
AFSMTS_class_wrap { %plug, namespace => '', dumper => q|tfihs_tfihs| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q <t::TestSuite::FSM> can't [tfihs_tfihs] method .,
AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[query_dumper]: defaulting {dumper} to \E\x24self.,
qq|$tag defaulting noted|;
like $stderr, qr.(?m)\Q[query_dumper]: {namespace} isa (t::TestSuite::FSM).,
qq|$tag defaulted noted|;
$tag = q|{dumper} isa defined method, {namespace} eq (),|;
AFSMTS_class_wrap { %plug, namespace => '', dumper => q|shift_shift| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{matrixone}, exists $bb->{CSSC}, $rc ],
[ q|Ekkisax|, '', q|Noralltach| ],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[query_dumper]: going for <t::TestSuite::FSM>->[shift_shift].,
qq|$tag noted|;
$tag = q|{dumper} isa defined method, {namespace} eq (), argument is set,|;
AFSMTS_class_wrap { %plug, namespace => '', dumper => q|shift_shift| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Quern_biter|;
is_deeply
[ @$bb{qw| matrixone CSSC |}, $rc ],
[qw| Claidheamh_Solius Quern_biter Samsamha |],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[query_dumper]: going for <t::TestSuite::FSM>->[shift_shift].,
qq|$tag noted|;
$tag =
q|{dumper} !isa defined method, {namespace} eq (t::TestSuite::dumper),|;
my $dumper = t::TestSuite::dumper->new;
undef $t::TestSuite::class_cheat;
AFSMTS_class_wrap
{ %plug, namespace => $dumper, dumper => q|tfihs_tfihs| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q <t::TestSuite::dumper> can't [tfihs_tfihs] method .,
AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[query_dumper]: defaulting {dumper} to \E\x24self.,
qq|$tag no defaulting|;
like $stderr,
qr.(?m)\Q[query_dumper]: {namespace} isa (t::TestSuite::dumper).,
qq|$tag {namespace} noted|;
$tag = q|{dumper} isa defined method, {namespace} eq (t::TestSuite::dumper),|;
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => $dumper, dumper => q|shift_shift| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $dumper->{aegis}, exists $bb->{matrixone}, $rc ],
[ q|Baptism|, '', q|Galatyn| ],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[query_dumper]: going for <t::TestSuite::dumper>->[shift_shift].,
qq|$tag noted|;
$tag =
q|{dumper} isa defined method, {namespace} eq (t::TestSuite::dumper), | .
q|argument is set,|;
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => $dumper, dumper => q|shift_shift| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Sting|;
is_deeply
[@$dumper{qw| aegis slash_briefcase |}, $rc ],
[qw| Murgleis Sting Haute_Claire |],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[query_dumper]: going for <t::TestSuite::dumper>->[shift_shift].,
qq|$tag noted|;
$tag =
q|{dumper} !isa defined subroutine, {namespace} eq (t::TestSuite::dumper),|;
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::dumper|, dumper => q|tfihs_tfihs| },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@,
qr.(?x)\[query_dumper\]:\h\<t::TestSuite::dumper\>\hpackage\h
can't\h\[tfihs_tfihs\].,
AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[query_dumper]: defaulting {dumper} to \E\x24self.,
qq|$tag no defaulting|;
like $stderr, qr.(?m)\Q[query_dumper]: {namespace} isa ().,
qq|$tag {namespace} isa scalar|;
$tag =
q|{dumper} isa defined subroutine, {namespace} eq (t::TestSuite::dumper),|;
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::dumper|, dumper => q|shift_shift| },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{aegis}, exists $bb->{matrixone}, $rc ], [ q|Waske|, '', q|Courtain| ],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[query_dumper]: going for <t::TestSuite::dumper>::[shift_shift].,
qq|$tag noted|;
$tag = q|{dumper} isa defined subroutine, | .
q|{namespace} eq (t::TestSuite::dumper), argument is set,|;
$dumper = t::TestSuite::dumper->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::dumper|, dumper => q|shift_shift| },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|Chastiefol|;
is_deeply
[@$bb{qw| aegis slash_briefcase |}, $rc ],
[qw| Stormbringer Chastiefol Hrunting |],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[query_dumper]: going for <t::TestSuite::dumper>::[shift_shift].,
qq|$tag noted|;
$tag = q|{dumper} returns empty,|;
AFSMTS_class_wrap { %plug, dumper => sub { } }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply $rc, q|(unclear)|, qq|$tag queried|;
$tag = q|{dumper} returns one item, item isa scalar|;
t/base/query_source.t view on Meta::CPAN
shift @main::flags }
package main;
use version 0.77; our $VERSION = version->declare( v2.3.2 );
use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 62;
use Acme::FSM;
our( $bb, $rc, $stderr );
our %st = ( );
my $method = q|query_source|;
my $tag;
our @flags =
qw| mustrum_ridcully quirm
djelibeybi pteppic
bravd creosote
xxxx tsort
angua ponder_stibbons
t/base/query_source.t view on Meta::CPAN
bel_shamharoth sergeant_colon
great_t_phon boy_willy
conina llamedos
agnes_nitt lancre |;
my %plug = ( diag_level => 5 );
$tag = q|{source} is missing,|;
AFSMTS_class_wrap { %plug }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
like $stderr, qr<(?m)\Q[connect]: (source): unset >, qq|$tag noted|;
AFSMTS_method_wrap $method;
like $@, qr.\Q {source} !isa defined., AFSMTS_croakson $tag;
$tag = q|{source} isa (undef),|;
AFSMTS_class_wrap { %plug, source => undef }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
like $stderr, qr<(?m)\Q[connect]: (source): unset >, qq|$tag noted|;
AFSMTS_method_wrap $method;
like $@, qr.\Q {source} !isa defined., AFSMTS_croakson $tag;
$tag = q|{source} isa (HASH),|;
AFSMTS_class_wrap { %plug, source => \$tag }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q isa (SCALAR)., AFSMTS_croakson $tag;
$tag = q|{source} isa (Acme::FSM),|;
t/base/query_source.t view on Meta::CPAN
like $@, qr.\Q {source} isa (Acme::FSM)., AFSMTS_croakson $tag;
$tag = q|{source} isa (CODE), {namespace} unset,|;
AFSMTS_class_wrap { %plug, source => \&t::TestSuite::FSM::shift_shift }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{Ashevill_pm}, exists $bb->{Anchorage_pm}, @$rc ],
[ q|mustrum_ridcully|, '', qw| quirm (quirm) |],
qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_source]: {source} isa (CODE)., qq|$tag noted|;
$tag = q|{source} isa (CODE), {namespace} unset, argument isa set,|;
AFSMTS_class_wrap { %plug, source => \&t::TestSuite::FSM::shift_shift }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|brutha|;
is_deeply
[ @$bb{qw| Ashevill_pm Anchorage_pm |}, @$rc ],
[qw| djelibeybi brutha pteppic (pteppic) |],
qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_source]: {source} isa (CODE)., qq|$tag noted|;
$tag = q|{source} isa (CODE), {namespace} isa set,|;
AFSMTS_class_wrap
{ %plug, namespace => q|vesta|, source => \&t::TestSuite::FSM::shift_shift },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{Ashevill_pm}, exists $bb->{Anchorage_pm}, @$rc ],
[ q|bravd|, '', qw| creosote (creosote) |],
qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_source]: {source} isa (CODE)., qq|$tag noted|;
$tag = q|{source} isa (CODE), {namespace} isa set, argument isa set,|;
AFSMTS_class_wrap
{ %plug, namespace => q|vesta|, source => \&t::TestSuite::FSM::shift_shift },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|littlebottom|;
is_deeply
[ @$bb{qw| Ashevill_pm Anchorage_pm |}, @$rc ],
[qw| xxxx littlebottom tsort (tsort) |],
qq|$tag queried|;
like $stderr, qr.(?m)\Q[query_source]: {source} isa (CODE)., qq|$tag noted|;
$tag = q|{source} isa (), {namespace} !isa defined,|;
AFSMTS_class_wrap { %plug, source => q|vorbis| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q {namespace} !isa defined., AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[query_source]: {source} isa ()., qq|$tag noted|;
$tag = q|{source} !isa defined method, {namespace} eq (),|;
$t::TestSuite::class_cheat = q|t::TestSuite::FSM|;
AFSMTS_class_wrap { %plug, namespace => '', source => q|tfihs_tfihs| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q <t::TestSuite::FSM> can't [tfihs_tfihs] method .,
AFSMTS_croakson $tag;
like $stderr, qr.(?m)\Q[query_source]: defaulting {source} to \E\x24self.,
qq|$tag defaulting noted|;
like $stderr, qr.(?m)\Q[query_source]: {namespace} isa (t::TestSuite::FSM).,
qq|$tag defaulted noted|;
$tag = q|{source} isa defined method, {namespace} eq (),|;
AFSMTS_class_wrap { %plug, namespace => '', source => q|shift_shift| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{Ashevill_pm}, exists $bb->{Anchorage_pm}, @$rc ],
[ q|angua|, '', qw| ponder_stibbons (ponder_stibbons) |],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[query_source]: going for <t::TestSuite::FSM>->[shift_shift].,
qq|$tag noted|;
$tag = q|{source} isa defined method, {namespace} eq (), argument is set,|;
AFSMTS_class_wrap { %plug, namespace => '', source => q|shift_shift| }, \%st;
isa_ok $bb, q|t::TestSuite::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|bel_shamharoth|;
is_deeply
[ @$bb{qw| Ashevill_pm Anchorage_pm |}, @$rc ],
[qw| king_verence bel_shamharoth sto_helit (sto_helit) |],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[query_source]: going for <t::TestSuite::FSM>->[shift_shift].,
qq|$tag noted|;
$tag =
q|{source} !isa defined method, {namespace} eq (t::TestSuite::source),|;
my $source = t::TestSuite::source->new;
undef $t::TestSuite::class_cheat;
AFSMTS_class_wrap
{ %plug, namespace => $source, source => q|tfihs_tfihs| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q <t::TestSuite::source> can't [tfihs_tfihs] method .,
AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[query_source]: defaulting {source} to \E\x24self.,
qq|$tag no defaulting|;
like $stderr,
qr.(?m)\Q[query_source]: {namespace} isa (t::TestSuite::source).,
qq|$tag {namespace} noted|;
$tag = q|{source} isa defined method, {namespace} eq (t::TestSuite::source),|;
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => $source, source => q|shift_shift| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $source->{Torino_pm}, exists $bb->{Ashevill_pm}, @$rc ],
[ q|bel_shamharoth|, '', qw| sergeant_colon (sergeant_colon) |],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[query_source]: going for <t::TestSuite::source>->[shift_shift].,
qq|$tag noted|;
$tag =
q|{source} isa defined method, {namespace} eq (t::TestSuite::source), | .
q|argument is set,|;
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => $source, source => q|shift_shift| }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|shawn_ogg|;
is_deeply
[ @$source{qw| Torino_pm Lund_pm |}, @$rc ],
[qw| great_t_phon shawn_ogg boy_willy (boy_willy) |],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[query_source]: going for <t::TestSuite::source>->[shift_shift].,
qq|$tag noted|;
$tag =
q|{source} !isa defined subroutine, {namespace} eq (t::TestSuite::source),|;
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::source|, source => q|tfihs_tfihs| },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@,
qr.(?mx)\[query_source\]:\h\<t::TestSuite::source\>\hpackage\h
can't\h\[tfihs_tfihs\].,
AFSMTS_croakson $tag;
unlike $stderr, qr.(?m)\Q[query_source]: defaulting {source} to \E\x24self.,
qq|$tag no defaulting|;
like $stderr, qr.(?m)\Q[query_source]: {namespace} isa ().,
qq|$tag {namespace} isa scalar|;
$tag =
q|{source} isa defined subroutine, {namespace} eq (t::TestSuite::source),|;
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::source|, source => q|shift_shift| },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply
[ $bb->{Torino_pm}, exists $bb->{Ashevill_pm}, @$rc ],
[ q|conina|, '', qw| llamedos (llamedos) |],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[query_source]: going for <t::TestSuite::source>::[shift_shift].,
qq|$tag noted|;
$tag = q|{source} isa defined subroutine, | .
q|{namespace} eq (t::TestSuite::source), argument is set,|;
$source = t::TestSuite::source->new;
AFSMTS_class_wrap
{ %plug, namespace => q|t::TestSuite::source|, source => q|shift_shift| },
\%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method, q|reg_shoe|;
is_deeply
[ @$bb{qw| Torino_pm Lund_pm |}, @$rc ],
[qw| agnes_nitt reg_shoe lancre (lancre) |],
qq|$tag queried|;
like $stderr,
qr.(?m)\Q[query_source]: going for <t::TestSuite::source>::[shift_shift].,
qq|$tag noted|;
$tag = q|{source} returns empty,|;
AFSMTS_class_wrap { source => sub { } }, \%st;
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
is_deeply $rc, [ undef, q|(undef)| ], qq|$tag queried|;
$tag = q|{source} returns one item, item isa scalar|;
t/base/query_switch.t view on Meta::CPAN
package main;
use version 0.77; our $VERSION = version->declare( v2.3.4 );
use t::TestSuite qw| :diag :wraps |;
use Test::More;
use Acme::FSM;
use List::Util qw| sum |;
our( $bb, $rc, $stderr );
our %st = ( START => { switch => undef, });
my $method = q|query_switch|;
our( $lock, $tag );
our @flags =
qw| m_files Chiocciola
archipel superversion
mercurial Valdimontone
surround_SCM asvcs
dcvs Aquila
t/base/query_switch.t view on Meta::CPAN
my( $lfix, $rfix ) = $unit->[2]->();
$st{START}{switch} = $lfix // $st{START}{switch};
if( grep $_ eq q|copy|, @{$unit->[1]} ) {
AFSMTS_object_wrap $bb, $rfix }
else {
AFSMTS_class_wrap { %plug, %$rfix }, \%st }
AFSMTS_method_wrap $method, @{$unit->[3]};
if( grep $_ eq q|pass|, @{$unit->[1]} ) {
is_deeply [ $unit->[4]->() ], $unit->[5], qq|$unit->[0], queried|;
grep $_ eq q|noise|, @{$unit->[1]} or next;
like $stderr, $unit->[6]{$_}, qq|$unit->[0], $_|
foreach keys %{$unit->[6]} }
elsif( grep $_ eq q|fail|, @{$unit->[1]} ) {
like $@, $unit->[4], AFSMTS_croakson qq|$unit->[0], queried|;
grep $_ eq q|noise|, @{$unit->[1]} or next;
Test::More->can( index( $_, '-' ) ? q|like| : q|unlike| )->
( $stderr, $unit->[5]{$_}, qq|$unit->[0], $_| )
foreach keys %{$unit->[5]} }}
# vim: set filetype=perl
t/base/state.t view on Meta::CPAN
use parent q|Acme::FSM|;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.1 );
use t::TestSuite qw| :diag :wraps |;
use Test::More tests => 10;
use Acme::FSM;
our( $bb, $rc, $stderr );
my $method = q|state|;
my( $old, $new ) = qw| START OK |;
AFSMTS_class_wrap { diag_level => 10 };
isa_ok $bb, q|Acme::FSM|, q|constructed object|;
is $bb->{_}{state}, $old, qq|initial {state} isa ($old)|;
my $tag = q|no args,|;
AFSMTS_method_wrap $method;
is_deeply [ $rc, $bb->{_}{state} ], [ $old, $old ], qq|$tag queried|;
$tag = q|one arg,|;
AFSMTS_method_wrap $method, $new;
is_deeply [ $rc, $bb->{_}{state} ], [ $old, $new ], qq|$tag queried|;
like $stderr, qr<(?m)^\Q[state]: changing state: ($old) ($new)>,
qq|$tag noted|;
$tag = q|other arg,|;
( $old, $new ) = ( $new, q|APOP| );
AFSMTS_method_wrap $method, $new;
is_deeply [ $rc, $bb->{_}{state} ], [ $old, $new ], qq|$tag queried|;
like $stderr, qr<(?m)^\Q[state]: changing state: ($old) ($new)>,
qq|$tag noted|;
$tag = q|two args,|;
AFSMTS_method_wrap $method, qw| LIST PASS |;
is_deeply [ !defined $rc, $bb->{_}{state} ], [ !0, $new ], qq|$tag queried|;
like $stderr, qr<(?m)^\Q[state]: too many args (2) >, qq|$tag noted|;
AFSMTS_method_wrap $method;
is $rc, $new, qq|$tag {state} stays|;
# vim: set filetype=perl
t/base/turn.t view on Meta::CPAN
package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );
use t::TestSuite qw| :diag :wraps |;
use Test::More;
use Acme::FSM;
use List::Util qw| sum |;
our( $bb, $rc, $stderr );
my %st = ( );
my %opts = ( diag_level => -t STDOUT ? 10 : 1 );
my $method = q|turn|;
my @data =
([ '', [qw| init |], { } ],
[ q|no args, no fst|,
[qw| pass |],
[ ],
[ 0, undef ],
t/base/turn.t view on Meta::CPAN
map { $_->[1] } @data;
foreach my $unit ( @data ) {
if( grep $_ eq q|init|, @{$unit->[1]} ) {
%st = %{$unit->[2]};
AFSMTS_class_wrap { %opts }, \%st }
elsif( grep $_ eq q|pass|, @{$unit->[1]} ) {
AFSMTS_method_wrap $method, @{$unit->[2]};
is_deeply [ scalar keys %{$bb->{_}{fst}}, $rc ], $unit->[3],
qq|$unit->[0], queried|;
like $stderr, $unit->[4], qq|$unit->[0], noted| unless
grep $_ eq q|quiet|, @{$unit->[1]} }
elsif( grep $_ eq q|fail|, @{$unit->[1]} ) {
AFSMTS_method_wrap $method, @{$unit->[2]};
like $@, $unit->[3], AFSMTS_croakson qq|$unit->[0], queried| }}
# vim: set filetype=perl
t/base/verify.t view on Meta::CPAN
package main;
use version 0.77; our $VERSION = version->declare( v2.3.2 );
use t::TestSuite qw| :diag :wraps |;
use Test::More;
plan tests => 38;
use Acme::FSM;
our( %st, $bb, $rc, $stderr );
our @flags =
qw| The_Night_We_Died Zaia
Muh Ka_III
Zombies De_Zeuhl_Undazir
Eliphas_Levi Maneh_Fur_Da_Zess
Troller_Tanz Ek_Sun_Da_Zess
C_est_la_Vie_Qui_les_A_Menes_La Nono
Do_The_Music Da_Zeuhl_Worts_Mekanik
Thaud Wainsaht
The_Last_Seven_Minutes Nebehr_Gudahtt
t/state/break.t view on Meta::CPAN
use warnings;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.5 );
use t::TestSuite qw| :switches :run :diag |;
use Test::More;
use Acme::FSM;
our( %st, $stderr );
our @inbase = ( undef, q|Roffa| );
our @input = @inbase;
our %opts = ( source => \&AFSMTS_shift, diag_level => -t STDOUT ? 10 : 1 );
my %common =
( state => q|CONTINUE|,
diag_level => $opts{diag_level},
namespace => undef,
source => $opts{source},
dumper => undef,
t/state/continue.t view on Meta::CPAN
use warnings;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.5 );
use t::TestSuite qw| :switches :wraps :run :diag |;
use Test::More;
use Acme::FSM;
our( %st, $stderr, @inbase, @input );
our %opts = ( source => \&AFSMTS_shift, diag_level => -t STDOUT ? 10 : 1 );
sub toggle_now ( ) {
@inbase = $inbase[0] ? ( undef ) x 5 : qw| mannaro | x 5;
@input = ( ) }
my $method = q|process|;
sub combo_now ( ) { toggle_now; AFSMTS_wrap; AFSMTS_method_wrap $method }
t/state/start.t view on Meta::CPAN
use warnings;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.3 );
use t::TestSuite qw| :switches :run :diag |;
use Test::More;
use Acme::FSM;
our( %st, $bb, $stderr, @input );
our @inbase = q|detritus|;
our %opts = ( source => \&AFSMTS_shift, diag_level => -t STDOUT ? 10 : 1 );
sub toggle_now ( ) {
@inbase = $inbase[0] ? ( undef ) x 5 :
qw| twoflower pseudopolis magrat_garlick offler granny_weatherwax |;
@input = ( ) }
my @data =
([ q|empty state table|, [qw| void |], { }, qr.\Q{switch} !isa defined . ],
t/state/stop.t view on Meta::CPAN
use warnings;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.5 );
use t::TestSuite qw| :switches :run :diag |;
use Test::More;
use Acme::FSM;
our( %st, $stderr );
our @inbase = ( undef, q|Roffa| );
our @input = @inbase;
our %opts = ( source => \&AFSMTS_shift, diag_level => -t STDOUT ? 10 : 1 );
my %common =
( state => q|STOP|,
diag_level => $opts{diag_level},
namespace => undef,
source => $opts{source},
dumper => undef,
t/state/workload.t view on Meta::CPAN
use warnings;
package main;
use version 0.77; our $VERSION = version->declare( v2.3.4 );
use t::TestSuite qw| :switches :run :diag |;
use Test::More;
use Acme::FSM;
our( %st, $stderr, @input );
our @inbase = q|Marriner|;
our %opts = ( source => \&AFSMTS_shift, diag_level => -t STDOUT ? 10 : 1 );
sub toggle_now ( ) {
@inbase = $inbase[0] ? ( undef ) x 5 :
qw| Amelia_Ducat Delta_Magna Stegnos Davros Mawdryn |;
@input = ( ) }
my %cache =
( tstart => { switch => sub { 1 }, tturn => [ q|workload| ]},