use Session::Token;
## The point of this test is to verify that we aren't doing anything stupid
## like a naive "mod" over our alphabet which would introduce character bias.
=pod
This test isn't so much a unit-test as a simple tool for verifying that
generated values fall within a certain acceptable range of bias. However,
this test is distributed to use the null seed because there is a chance
that some short-term run of random values would trigger a failure (they
are random numbers after all).
Of course, as the total number of values generated increases, we get more
confident that the values generated are unbiased. Because Session::Token
extracts bytes from the PRNG, any bias in our characters will be fairly
pronounced. The most difficult alphabet to detect bias in would be
something like this:
[ map { chr } (0, 0 .. 254) ]
Note how the 0 is repeated twice.
P(0) = 2/256
P(1) = 1/256
...
P(254) = 1/256
Algorithms that extract entire words from the PRNG and use these words
in the modulus computation will have more difficult to detect bias.
For further investigation, set the S_T_NON_DETERMINISTIC environment
variable to have it run with a random seed (will fail every now and
again due to pure chance).
The default alphabet, total number of characters to generate, and
tolerance threshold can be controlled with S_T_ALPHABET, S_T_TOTAL,
and S_T_TOLERANCE.
Example: To see this test fail with the example used in L<Session::Token>'s
mod bias example, run the tests with the alphabet set to "aabc":
$ S_T_ALPHABET=aabc make test
...
t/no-mod-bias.t .... Not within tolerance: a (97): 0.99636 > 0.01 at t/no-mod-bias.t line 95.
=cut
use strict;
use Test::More tests => 1;
my $seed = $ENV{S_T_NON_DETERMINISTIC} ? undef : ("\x00" x 1024),
my $alphabet = $ENV{S_T_ALPHABET} || 'abc',
#my $alphabet = $ENV{S_T_ALPHABET} || (join "", ( map { chr } (255, 0 .. 254) ));
my $total = $ENV{S_T_TOTAL} || 100000;
my $tolerance = $ENV{S_T_TOLERANCE} || 0.01;
my $ideal_per_bucket = $total / length($alphabet);
my $ctx = Session::Token->new(
alphabet => $alphabet,
length => $total,
seed => $seed,
);
my $token = $ctx->get;
my $counts = {};
$token =~ s/(.)/$counts->{$1}++/seg;
my $total_verification = 0;
foreach my $c (split //, $alphabet) {
$total_verification += $counts->{$c};
verify_tolerance($c);
}
is($total_verification, $total, 'no bias detected');
done_testing();
sub verify_tolerance {
my $c = shift;
my $deviation = abs(1 - ($counts->{$c} / $ideal_per_bucket));
my $printable_c = (ord($c) >= 32 && ord($c) <= 126) ? $c : '*unprintable*';
print "Deviation of $printable_c (" . ord($c) . "): $deviation\n";
die "Not within tolerance: $printable_c (" . ord($c) . "): $deviation > $tolerance"
if $deviation > $tolerance;
}