view release on metacpan or  search on metacpan

lib/Test/Games/BonDigi.pm  view on Meta::CPAN

    ok(ref $iter eq 'CODE', 'Iterator with object');

    my $iter2 = Games::BonDigi->sequence();
    ok(ref $iter2 eq 'CODE', 'Iterator with class');

    my $word = $iter->();
    is($iter2->(), $word, 'class/object iterators are equivalent');

    # Test iterator fixed part
    is($word, 'bon',      'Header: first word is "bon"');
    is($iter->(), 'digi', 'Header: then "digi"');
    is($iter->(), 'bon',  'Header: then "bon" again');
    is($iter->(), 'digi', 'Header: then "digi" again');

    # Payload 
    is($iter->(), 'bon',  'Payload: "bon"');
    is($iter->(), 'bon',  'Payload: "bon" again');
    is($iter->(), 'digi', 'Payload: "digi"');
    is($iter->(), 'digi', 'Payload: "digi" again');

    # Restart
    is($iter->(), 'bon',  'Restart of sequence: "bon"');

    # Sequence must be uninterrupted
    my $words_re = qr/bon|digi/;
    for(1 .. 100)
    {
        like($iter->(), $words_re, 'next ' . $_ . ' word is correct');
    }

    return;
}

sub iterator_custom : Test(16)
{
    my $obj = Games::BonDigi->new();
    isa_ok($obj, 'Games::BonDigi', 'class constructor');

    # Start with 2 repeats, end at 5, words are: x, y
    my $iter = $obj->sequence(2, 5, qw(x y));
    ok(ref $iter eq 'CODE', 'Custom iterator with object');
    
    my $iter2 = Games::BonDigi->sequence(2, 5, qw(x y));
    ok(ref $iter2 eq 'CODE', 'Custom iterator with class');

    # Iterator sequence must stop at 5
    my @seq = ();

    # Detect infinite loops (broken iterator)
    eval
    {
        local $SIG{ALRM} = sub { die 'Endless loop' };
        alarm 5;
        while(my $word = $iter->())
        {
            push @seq, $word;
        }
        alarm 0;
    };

    unlike($@, qr/Endless loop/, 'iterator correctly stops at given endpoint');

    # Test iterator fixed part
    is($seq[0], 'x', 'first word is "x"');
    is($seq[1], 'y', 'then "y"');
    is($seq[2], 'x', 'then "x" again');
    is($seq[3], 'y', 'then "y" again');

    # Payload 
    is($seq[4], 'x',  'Payload: "x"');
    is($seq[5], 'x',  '"x" again');
    is($seq[6], 'y', 'Payload: "y"');
    is($seq[7], 'y', '"y" again');

    # Sanity tests on generated sequence
    is(scalar(@seq), 4 * 4 + (2 + 3 + 4 + 5) * 2, 'sequence was generated exactly, no less and no more');
    is($seq[$#seq], 'y', 'last element must be "y"');

    # Same number of 'x' and 'y' must have been generated
    my $num_x = 0;
    my $num_y = 0;

    for(@seq)
    {
        if($_ eq 'x')    { $num_x++ }
        elsif($_ eq 'y') { $num_y++ }
    }

    is($num_x, $num_y, '"x" elements == "y" elements');
    is($num_x + $num_y, scalar(@seq), 'only "x" and "y" have been generated');

    return;
}

1;

__END__

=head1 NAME

Test::Games::BonDigi

=head1 ABSTRACT

Testing class for Games::BonDigi. Uses Test::Class.

=head1 SYNOPSIS

Don't use that.

=head1 DESCRIPTION

Testing class for Games::BonDigi.
Uses Test::Class framework.

=head1 DEDICATION

To Q&A Departments in all the planet.

=head1 METHODS