euchre-live

Euchre web-app for the socially distant family
git clone git://git.alexkarle.com/euchre-live.git
Log | Files | Refs | README | LICENSE

Rules.t (2526B) [raw]


      1 #!/usr/bin/env perl
      2 # Rules.t -- tests for Euchre::Rules
      3 use strict;
      4 use warnings;
      5 
      6 use FindBin;
      7 use lib "$FindBin::Bin/../lib";
      8 
      9 use Euchre::Rules;
     10 use List::Util;
     11 use Test::More;
     12 
     13 sub test_deal {
     14     my ($handsA, $kiddey) = deal();
     15     is(scalar @{$handsA}, 4, '4 hands dealt');
     16     is(scalar @{$kiddey}, 4, '4 cards in kiddey');
     17     
     18     my @cards;
     19     push @cards, @{$_} for @{$handsA};
     20     is(scalar @cards, 20, '20 cards dealt to hands');
     21 
     22     my @all_suits = qw(H D S C);
     23     my @all_cards = qw(N T J Q K A);
     24     my @full_deck;
     25     for my $c (@all_cards) {
     26         for my $s (@all_suits) {
     27             push @full_deck, "$c$s";
     28         }
     29     }
     30 
     31     my @dealt = sort(@cards, @{$kiddey});
     32     is_deeply(\@dealt, [sort @full_deck], 'All 24 cards dealt');
     33 
     34 }
     35 
     36 sub test_trick_winner {
     37     my @tests = (
     38         # [Trump, Led, Cards], Winner Idx, Desc
     39         [['H', 'H', 'NH', 'TS', 'AS', 'QS'], 0, 'Trump suit led'],
     40         [['D', 'H', 'JH', 'TS', 'JD', 'QD'], 2, 'Jack trump beats all'],
     41         [['D', 'C', 'NC', 'JH', 'AD', 'AC'], 1, 'Jack color beats all others'],
     42         [['S', 'S', 'NS', 'JH', 'AD', 'JC'], 3, 'Jack color beats all others (2)'],
     43         [['S', 'H', 'NS', 'JH', 'AD', 'AH'], 0, 'Trump beats ace'],
     44         [['C', 'H', 'NH', 'JH', 'QH', 'AH'], 3, 'No trump, highest of led'],
     45         [['C', 'H', 'NH', 'JH', 'AH'], 2, 'No trump, highest of led, 3 cards'],
     46         [['C', 'S', 'NH', 'JH', 'AH', 'NS'], 3, 'No trump, suit led wins'],
     47     );
     48 
     49     for my $t (@tests) {
     50         my ($trump, $led, @cards) = @{$t->[0]};
     51         is(trick_winner($trump, $led, @cards), $t->[1], $t->[2]);
     52     }
     53 
     54 }
     55 
     56 sub test_score_round {
     57     my @tests = (
     58         [[0, 1,2,1,1], [1, 2], 'Euched!'],
     59         [[1, 2,1,1,1], [0, 2], 'Euched again!'],
     60         [[3, 2,3,0,0], [1,1], 'Made your point'],
     61         [[1, 0,3,0,2], [1,2], 'Got em all!'],
     62         [[0, 5,0,'X',0], [0,4], 'Loneeeer!'],
     63         [[2, 3,1,'X',1], [0,1], 'Failed loner'],
     64     );
     65 
     66     for my $t (@tests) {
     67         my ($winners, $points) = score_round(@{$t->[0]});
     68         is_deeply([$winners, $points], $t->[1], $t->[2]);
     69     }
     70 }
     71 
     72 sub test_card_value {
     73     ok(card_value('AH', 'H') < card_value('JH', 'H'), 'right bower highest');
     74     ok(card_value('AH', 'H') < card_value('JD', 'H'), 'left bower higher than ace');
     75     ok(card_value('JH', 'H') > card_value('JD', 'H'), 'left bower lower');
     76     ok(card_value('ND', 'H', 'D') > card_value('TC', 'H', 'D'), 'throwoff');
     77 }
     78 
     79 test_deal();
     80 test_trick_winner();
     81 test_score_round();
     82 test_card_value();
     83 
     84 done_testing();