view release on metacpan or  search on metacpan

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

# $Id: connect.t 481 2013-02-17 02:09:10Z whynot $
# Copyright 2012, 2013 Eric Pozharski <whynot@pozharski.name>
# GNU GPLv3
# AS-IS, NO-WARRANTY, HOPE-TO-BE-USEFUL

use strict;
use warnings;

package t::TestSuite::FSM;
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|;