view release on metacpan or  search on metacpan

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

# $Id: query_source.t 482 2013-03-08 22:47:45Z 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 qw| Acme::FSM |;

sub shift_shift       {
    my $bb        = shift @_;
    $bb->{Ashevill_pm}  = shift @main::flags;
    $bb->{Anchorage_pm} = shift @_                                      if @_;
    shift @main::flags }

package t::TestSuite::source;

sub new { bless { }, shift @_ }

sub shift_shift       {
    my $bb           = shift @_;
    $bb->{Torino_pm} = shift @main::flags;
    $bb->{Lund_pm}   = shift @_                                         if @_;
    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
    king_verence        sto_helit
    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),|;
AFSMTS_object_wrap $bb, { %plug, source => $bb };
isa_ok $bb, q|Acme::FSM|, qq|$tag constructed object|;
AFSMTS_method_wrap $method;
like $@, qr.\Q {source} isa (Acme::FSM)., AFSMTS_croakson $tag;