| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
4
|
|
|
4
|
|
2516
|
use strict; |
|
|
4
|
|
|
|
|
10
|
|
|
|
4
|
|
|
|
|
122
|
|
|
2
|
4
|
|
|
4
|
|
23
|
use warnings; |
|
|
4
|
|
|
|
|
14
|
|
|
|
4
|
|
|
|
|
98
|
|
|
3
|
4
|
|
|
4
|
|
64
|
use 5.024; |
|
|
4
|
|
|
|
|
14
|
|
|
4
|
|
|
|
|
|
|
# use feature qw /postderef signatures/; |
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Vote::Count::Helper::TestBalance; |
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION='2.01'; |
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# ABSTRACT: Custom Test for checking STV charge calculations. |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Vote::Count::Helper::TestBalance; |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 VERSION 2.01 |
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 Synopsis |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $Charges = { 'choice1' => 55, 'choice2' => 79 }; |
|
21
|
|
|
|
|
|
|
my $balanceValue = $remaining_vote_value; |
|
22
|
|
|
|
|
|
|
balance_ok( $BallotSet, $charges, $balanceValue, [ @elected ], $test_name); |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 balance_ok |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
Compare current charges with the ballotset and the remaining vote_value to confirm that the charges would balance. Used for testing FullCascade Charge. |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
This method is exported. |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=cut |
|
31
|
|
|
|
|
|
|
|
|
32
|
4
|
|
|
4
|
|
26
|
use Test2::API qw/context/; |
|
|
4
|
|
|
|
|
12
|
|
|
|
4
|
|
|
|
|
277
|
|
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
our @EXPORT = qw/balance_ok/; |
|
35
|
4
|
|
|
4
|
|
26
|
use base 'Exporter'; |
|
|
4
|
|
|
|
|
9
|
|
|
|
4
|
|
|
|
|
1501
|
|
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub balance_ok :prototype($$$$;$) { |
|
38
|
1
|
|
|
1
|
0
|
6
|
my ( $Ballots, $charge, $balance, $elected, $name ) = @_; |
|
39
|
1
|
50
|
|
|
|
5
|
$name = 'check balance of charges and votes' unless $name; |
|
40
|
1
|
|
|
|
|
3
|
my $valelect = 0; |
|
41
|
1
|
|
|
|
|
2
|
for ( @{$elected} ) { |
|
|
1
|
|
|
|
|
3
|
|
|
42
|
3
|
|
|
|
|
8
|
$valelect += $charge->{$_}{'value'}; |
|
43
|
|
|
|
|
|
|
} |
|
44
|
1
|
|
|
|
|
2
|
my $valremain = 0; |
|
45
|
1
|
|
|
|
|
121
|
for my $k ( keys $Ballots->%* ) { |
|
46
|
|
|
|
|
|
|
$valremain += |
|
47
|
1014
|
|
|
|
|
1602
|
$Ballots->{$k}{'votevalue'} * $Ballots->{$k}{'count'}; |
|
48
|
|
|
|
|
|
|
} |
|
49
|
1
|
|
|
|
|
42
|
my $valsum = $valremain + $valelect; |
|
50
|
1
|
|
|
|
|
8
|
my $warning = "### $valsum ($valremain + $valelect) != $balance ###"; |
|
51
|
1
|
|
|
|
|
7
|
my $ctx = context(); # Get a context |
|
52
|
1
|
|
|
|
|
118
|
$ctx->ok( $valsum == $balance, $name, [ "$name\n\t$warning"] ); |
|
53
|
1
|
|
|
|
|
354
|
$ctx->release; # Release the context |
|
54
|
1
|
|
|
|
|
30
|
return 1; |
|
55
|
|
|
|
|
|
|
} |
|
56
|
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
1; |
|
58
|
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
#FOOTER |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=pod |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
BUG TRACKER |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
L<https://github.com/brainbuz/Vote-Count/issues> |
|
66
|
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
AUTHOR |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
John Karr (BRAINBUZ) brainbuz@cpan.org |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
CONTRIBUTORS |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Copyright 2019-2021 by John Karr (BRAINBUZ) brainbuz@cpan.org. |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
LICENSE |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
This module is released under the GNU Public License Version 3. See license file for details. For more information on this license visit L<http://fsf.org>. |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
SUPPORT |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
This software is provided as is, per the terms of the GNU Public License. Professional support and customisation services are available from the author. |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=cut |
|
84
|
|
|
|
|
|
|
|