#!/usr/bin/perl -w
use strict;
use Test::More tests => 248;
BEGIN { use_ok( 'Test::LectroTest::Generator', qw(:common :combinators) ) }
=head1 NAME
gens.t - Unit tests for Test::LectroTest::Generator
=head1 SYNOPSIS
perl -Ilib t/gens.t
=head1 DESCRIPTION
B This test suite relies upon a number of randomized tests
and statistical inferences. As a result, there is a small probability
(about 1 in 200) that some part of the suite will fail even if
everything is working properly. Therefore, if a test fails, re-run
the test suite to determine whether the supposed problem is real or
just a rare instance of the Fates poking fun at you.
This documentation is written mainly for programmers who maintain the
test suite. If you are an end user of the LectroTest modules, you can
stop reading now because otherwise you will be bored to tears.
=cut
# set up warning net for errors in this test suite
BEGIN {
no warnings 'redefine';
my $failures;
my $ok = \&Test::Builder::ok;
*Test::Builder::ok = sub { (my $r = $ok->(@_)) || emit_warning(); $r };
}
sub emit_warning {
Test::Builder->new->diag(<isa('Test::LectroTest::Generator'),
"$_ ctor returns a Test::LectroTest::Generator");
}
#==============================================================================
#==============================================================================
#==============================================================================
# Helpers
sub clipped_triangle_mean($$$) {
my ($m,$s,$n) = @_;
my $bot = max($m,$s);
my $mfrac = max(($m-$s)/($n-$s+1),0);
return $m + (1-$mfrac) * (($bot-$m)/2+($n-$bot)/4);
}
sub max {
my $max;
foreach (@_) {
$max = $_ if !defined($max) || $_ > $max;
}
$max;
}
#==============================================================================
#==============================================================================
#==============================================================================
=head1 Generator tests
Here we test the generators. We perform the following tests.
=cut
#==============================================================================
=pod
=head2 Bool
The Bool distribution is really an Int distribution over the
range [0,1]. Therefore, we make sure that it has a mean of 0.5.
=cut
dist_mean_ok("Bool", Bool, [1..$tsize], sub{$_[0]}, 0.5);
#==============================================================================
=pod
=head2 Char
The Char distribution should return only the characters in the set we
give it, and all of the characters in the set should be possible
output values. First, we test to see that a trivial Char generator
for a single character always returns that character.
=cut
{
my $gstr = 'Char(charset=>"x")';
my $gen = eval $gstr;
my @vals = map {$gen->generate($_)} 1..1000;
is( scalar( grep { $_ eq "x" } @vals ), 1000,
"$gstr generates only 'x' values" );
}
=pod
Next, we make sure that a Char generator with a ten-character
range generates all ten characters and does so with equal
probability.
=cut
{
my $gstr = 'Char(charset=>"a-j")';
my $gen = eval $gstr;
complete_and_uniform_ok($gen, $gstr, ["a".."j"]);
}
=pod
Next, we run a few tests to make sure that the parser for
character set specifications work. We try the following:
"a", "-", "a-a", "-a", "a-", "aA-C", "A-Ca":
=cut
# cset-spec expected charset
for ( ["a" ,"a" ],
["-" ,"-" ],
["a-a" ,"a" ],
["-a" ,"-a" ],
["a-" ,"-a" ],
["aA-C" ,"ABCa" ],
["A-Ca" ,"ABCa" ],
["X-YaA-C" ,"ABCXYa" ],
["A-CaX-Y" ,"ABCXYa" ],
)
{
my ($cspec, $expected) = @$_;
my @expected = split //, $expected;
my $gstr = "Char(charset=>'$cspec')";
my $gen = eval $gstr;
my @got = map { $gen->generate } 1..10_000;
@got = sort keys %{{ map {($_,1)} @got }}; # uniq
my $got = join '', @got;
is ($got, $expected, "$gstr generated the char set '$expected'");
}
#==============================================================================
=pod
=head2 Elements and OneOf
The Elements tests indirectly test OneOf, upon which the Elements
generator is built. We ensure that the Elements distribution is
complete and uniform.
=cut
for ([0..9],["a".."j"])
{
my $g = Elements(@$_);
complete_and_uniform_ok($g, "Elements(@$_)", $_);
}
=pod
We must also test the pre-flight check.
=cut
like( eval { Elements() } || $@,
qr/must be.*at least one element/,
"pre-flight: Elements() caught"
);
#==============================================================================
=pod
=head2 Float
The Float tests are modeled after the Int tests, but there are subtle
differences in order to accomodate the differences between the
underlying generators. In particular, Float has an (approximately)
continuous distribution whereas Int has a discrete distribution.
First, we test seven Float generators having ranges 201 wide and
centered around -300, -200, ... 200, 300. The generators are unsized
(B0>) and thus should have means at the range centers.
=cut
for (-3..3) {
my $center = $_ * 100;
my ($m,$n) = ($center-100, $center+100);
dist_mean_ok("Float(sized=>0,range=>[$m,$n])",
Float(sized=>0,range=>[$m,$n]),
[1..$tsize],sub{$_[0]}, $center);
}
=pod
Second, we test five more Float generators having ranges from [0,$span]
where $span becomes increasingly large, finally equaling the
configuration parameter $tsize. These generators are sized, and so we
would expect the mean of their distributions to be equal to a weighted
average of X1 and X2, where X1 is the mean of the equivalent un-sized
distribution, and X2 is half of the mean of the sizing guidance over
the range of values for which the sizing constrains the range.
=cut
for (1..5) {
my $span = $_ * $tsize/5;
# Weights Means
my $expected_mean = (($tsize-$span)/$tsize)* ($span/2) # X1
+ ($span/$tsize) * ($span/4); # X2
dist_mean_ok("Float(sized=>1,range=>[0,$span])",
Float(sized=>1,range=>[0,$span]),
[0..$tsize],sub{$_[0]}, $expected_mean);
}
=pod
Third, we repeat the above test, this time using balanced ranges
[-$span,$span] for the same increasing progression of $span values.
Because the range is balanced, as is the effect of sizing, the
mean of the distributions must be zero.
=cut
for (1..5) {
my $span = $_ * $tsize/5;
dist_mean_ok("Float(sized=>1,range=>[-$span,$span])",
Float(sized=>1,range=>[-$span,$span]),
[0..$tsize],sub{$_[0]}, 0);
}
=pod
Fourth, we run a series of unsized tests over 3-element ranges near
zero. Because the ranges are so small, we expect that if there were
off-by-one errors in the code, they would stand out here.
=cut
for (-3..3) {
my ($m,$n) = ($_-1,$_+1);
dist_mean_ok("Float(sized=>0,range=>[$m,$n])",
Float(sized=>0,range=>[$m,$n]),
[0..$tsize],sub{$_[0]}, $_);
}
=pod
Fifth, we make sure that LectroTest prevents us from providing an
empty range.
=cut
for ( 'Float(range=>[1,0])', 'Float(range=>[0,-1])' ) {
like( eval $_ || $@,
qr/is empty/,
"$_ is caught as an empty range" );
}
for ( 'Float(range=>[0,0])' ) {
isa_ok( eval $_,
'Test::LectroTest::Generator',
"$_ is not wrongly caught as empty / " );
}
=pod
Sixth, we test the case where the generator is called
without sizing guidance. In this case the full range is
used.
=cut
for (-3..3) {
my ($m,$n) = ($_ - 4, $_ + 4);
my $g = Sized { undef } Float(range=>[$m,$n]);
dist_mean_ok("Sized{undef} Float(range=>[$m,$n])",
$g, [(undef)x$tsize], sub{$_[0]}, $_);
}
=pod
Finally, we make sure that LectroTest prevents us from using a sized
generator with a given range that does not contain zero.
=cut
for ( 'Float(range=>[-10,-1])', 'Float(range=>[1,10])' ) {
like( eval $_ || $@,
qr/does not contain zero/,
"$_ is caught as incompatible with sizing" );
}
for ( 'Float(range=>[-10,0])', 'Float(range=>[0,10])', 'Float' ) {
isa_ok( eval $_,
'Test::LectroTest::Generator',
"$_ is not wrongly caught as incompatible with sizing /" );
}
#==============================================================================
#==============================================================================
=pod
=head2 Int
We must test Int hardcore because it is the generator upon which
most others are built.
First, we test seven Int generators having ranges ten elements
wide and centered around -3000, -2000, ... 2000, 3000.
We ensure that each of the generators is complete and uniformly
distributed.
=cut
for (-3..3) {
my $center = $_ * 1_000;
my ($m,$n) = ($center-5, $center+4);
my $g = Int(sized=>0,range=>[$m,$n]);
complete_and_uniform_ok($g, "Int(sized=>0,range=>[$m,$n])",[$m..$n]);
}
=pod
Second, we test seven more Int generators having ranges 201 elements
wide and centered around -300, -200, ... 200, 300. The generators
are unsized (B0>) and thus should have means at the
range centers.
=cut
for (-3..3) {
my $center = $_ * 100;
my ($m,$n) = ($center-100, $center+100);
dist_mean_ok("Int(sized=>0,range=>[$m,$n])",
Int(sized=>0,range=>[$m,$n]),
[1..$tsize],sub{$_[0]}, $center);
}
=pod
Third, we test five more Int generators having ranges from [0,$span]
where $span becomes increasingly large, finally equaling the
configuration parameter $tsize. These generators are sized, and so we
would expect the mean of their distributions to be equal to a weighted
average of X1 and X2, where X1 is the mean of the equivalent un-sized
distribution, and X2 is half of the mean of the sizing guidance over
the range of values for which the sizing constrains the range.
=cut
for (1..5) {
my $span = $_ * $tsize/5;
# Weights Means
my $expected_mean = (($tsize-$span)/$tsize)* ($span/2) # X1
+ ($span/$tsize) * ($span/4); # X2
dist_mean_ok("Int(sized=>1,range=>[0,$span])",
Int(sized=>1,range=>[0,$span]),
[0..$tsize],sub{$_[0]}, $expected_mean);
}
=pod
Fourth, we repeat the above test, this time using balanced ranges
[-$span,$span] for the same increasing progression of $span values.
Because the range is balanced, as is the effect of sizing, the
mean of the distributions must be zero.
=cut
for (1..5) {
my $span = $_ * $tsize/5;
dist_mean_ok("Int(sized=>1,range=>[-$span,$span])",
Int(sized=>1,range=>[-$span,$span]),
[0..$tsize],sub{$_[0]}, 0);
}
=pod
Fifth, we run a series of unsized tests over 3-element ranges near
zero. Because the ranges are so small, we expect that if there were
off-by-one errors in the code, they would stand out here.
=cut
for (-3..3) {
my ($m,$n) = ($_-1,$_+1);
dist_mean_ok("Int(sized=>0,range=>[$m,$n])",
Int(sized=>0,range=>[$m,$n]),
[0..$tsize],sub{$_[0]}, $_);
}
=pod
Sixth, we make sure that LectroTest prevents us from providing an
empty range.
=cut
for ( 'Int(range=>[1,0])', 'Int(range=>[0,-1])' ) {
like( eval $_ || $@,
qr/is empty/,
"$_ is caught as an empty range" );
}
for ( 'Int(range=>[0,0])' ) {
isa_ok( eval $_,
'Test::LectroTest::Generator',
"$_ is not wrongly caught as empty / " );
}
=pod
Seventh, we test the case where the generator is called
without sizing guidance. In this case the full range is
used.
=cut
for (-3..3) {
my ($m,$n) = ($_ - 5, $_ + 4);
my $g = Sized { undef } Int(range=>[$m,$n]);
complete_and_uniform_ok($g, "Sized{undef} Int(range=>[$m,$n])",[$m..$n]);
}
=pod
Finally, we make sure that LectroTest prevents us from using a sized
generator with a given range that does not contain zero.
=cut
for ( 'Int(range=>[-10,-1])', 'Int(range=>[1,10])' ) {
like( eval $_ || $@,
qr/does not contain zero/,
"$_ is caught as incompatible with sizing" );
}
for ( 'Int(range=>[-10,0])', 'Int(range=>[0,10])', 'Int' ) {
isa_ok( eval $_,
'Test::LectroTest::Generator',
"$_ is not wrongly caught as incompatible with sizing /" );
}
#==============================================================================
=pod
=head2 Hash
Hash is a thin wrapper around List and so we need only a few
Hash-specific tests to get good coverage.
=cut
for( 'Unit(0),Unit(1) {0=>1}',
'Int(range=>[0,5],sized=>0),Unit(1),length=>1000 {0=>1,1=>1,2=>1,3=>1,4=>1,5=>1}' )
{
my ($hash_args, $expected) = split ' ', $_, 2;
my $gen_spec = "Hash($hash_args)";
is_deeply( (eval $gen_spec)->generate(1000),
eval $expected,
"$gen_spec gens $expected");
}
=pod
Still, we need to test the pre-flight checks.
=cut
like( eval { Hash(Int) } || $@,
qr/requires two/,
"pre-flight: Hash(Int) caught"
);
#==============================================================================
=pod
=head2 List
We consider four test cases to determine whether List respects
its B modifier. First, we test the default list generation
method, where list length is constrained only by the sizing guidance.
For sizing guidance in [1..I], the expected mean generated list
length is (1+I)/4.
=cut
{
my $gstr = "List(Unit(1))";
my $gen = eval $gstr;
for (1,5,10,25) {
dist_mean_ok( "$gstr elem length under sizing [1..$_]",
$gen, [(1..$_)x($tsize/$_)],
sub { scalar @{$_[0]} }, (1+$_)/4 );
}
}
=pod
Second, we test the B>I variant. It should
generate lists whose length always equals I.
=cut
{
for my $len (0..3) {
my $gstr = "List(Unit('x'),length=>$len)";
my $gen = eval $gstr;
my @vals = map {$gen->generate($_)} 1..$tsize;
is( scalar ( grep { $len == grep {'x' eq $_} @$_ } @vals ), $tsize,
"All lists from $gstr are [('x')x$len]" );
}
}
=pod
Third, we test the B>[I,] variant. For sizing
guidance in [I~~..I], the expected mean of the
distribution is given by the formula in the helper
function C(I,I~~~~,I).
(Note that when I=0 this case is equivalent to the first case.)
=cut
{
for my $s (0,1,2) {
for ([0,5],[1,5],[4,5],[5,10]) {
my ($m,$n) = @$_;
my $gstr = "List(Unit('x'),length=>[$m,])";
my $gen = eval $gstr;
dist_mean_ok("$gstr elem length under sizing [$s..$n]",
$gen, [($s..$n)x($tsize/$n)],
sub { scalar @{$_[0]} },
clipped_triangle_mean($m,$s,$n));
}
}
}
=pod
Fourth, we test the B>[I,I] variant. The
expected mean generated list length is (I+I)/2, regardless
of sizing guidance (which should be ignored in this case).
=cut
for (0..3) {
$_ *= 10;
my ($m,$n) = ($_,$_+9);
my $gstr = "List(Unit('x'),length=>[$m,$n])";
my $gen = eval $gstr;
dist_mean_ok("$gstr elem length",
$gen, [0..$tsize],
sub { scalar @{$_[0]} }, ($m+$n)/2 );
}
=pod
Fifth, we check to see if List's pre-flight checks catch common
problems.
=cut
like( eval { List(Int,length=>-1) } || $@,
qr/length.*< 0/,
"pre-flight: List(length=>-1) caught"
);
like( eval { List(Int,length=>[-1]) } || $@,
qr/length.*< 0/,
"pre-flight: List(length=>[-1,]) caught"
);
like( eval { List(Int,length=>[-1,0]) } || $@,
qr/length.*invalid/,
"pre-flight: List(length=>[-1,0]) caught"
);
like( eval { List(Int,length=>[1,0]) } || $@,
qr/length.*invalid/,
"pre-flight: List(length=>[1,0]) caught"
);
for ("[]", "[0,1,2]", "{1=>1}") {
like( eval "List(Int,length=>$_)" || $@,
qr/length spec.*bad/,
"pre-flight: List(length=>$_) caught"
);
}
#==============================================================================
=pod
=head2 String
We consider four test cases to determine whether String respects its
B modifier. These test cases are nearly identical to the four
cases for the List generator. Because String is built on List, these
tests are mostly redundant. However, it is a good idea to have them
anyway because it frees us to change the implementation.
First, we test the default string generation method, where string
length is constrained only by the sizing guidance. For sizing
guidance in [1..I], the expected mean generated string length is
(1+I)/4.
=cut
{
my $gstr = "String()";
my $gen = eval $gstr;
for (1,5,10,25) {
dist_mean_ok( "$gstr length under sizing [1..$_]",
$gen, [(1..$_)x($tsize/$_)],
sub { length $_[0] }, (1+$_)/4 );
}
}
=pod
Second, we test the B>I variant. It should
generate strings whose length always equals I.
=cut
{
for my $len (0..3) {
my $gstr = "String(charset=>'x',length=>$len)";
my $gen = eval $gstr;
my @vals = map {$gen->generate($_)} 1..$tsize;
is( scalar ( grep { $_ eq "x"x$len } @vals ), $tsize,
"All strings from $gstr are '" . ("x"x$len) . "'" );
}
}
=pod
Third, we test the B>[I,] variant. For sizing
guidance in [I~~~~..I] we have the expected mean of the
distribution is given by the formula in the helper function
C(I,I~~~~,I).
(Note that when I=0, this test case is equivalent to the first.)
=cut
{
for my $s (0,1,2) {
for ([0,5],[1,5],[4,5],[5,10]) {
my ($m,$n) = @$_;
my $gstr = "String(length=>[$m,])";
my $gen = eval $gstr;
dist_mean_ok("$gstr length under sizing [$s..$n]",
$gen, [($s..$n)x($tsize/$n)],
sub { length $_[0] },
clipped_triangle_mean($m,$s,$n));
}
}
}
=pod
Fourth, we test the B>[I,I] variant. The
expected mean generated string length is (I+I)/2, regardless
of sizing guidance (which should be ignored in this case).
=cut
for (0..3) {
$_ *= 10;
my ($m,$n) = ($_,$_+9);
my $gstr = "String(length=>[$m,$n])";
my $gen = eval $gstr;
dist_mean_ok("$gstr elem length",
$gen, [0..$tsize],
sub { length $_[0] }, ($m+$n)/2 );
}
#==============================================================================
=pod
=head2 Unit
The Unit generator is simple and always returns the same value.
So we test it with three values: "a", 1, and 0.334.
=cut
for (qw|"a" 1 0.334|) {
my $v = eval $_;
ok(Unit($v)->generate eq $v, "Unit($_)->generate eq $_");
}
#==============================================================================
#==============================================================================
#==============================================================================
=head1 Combinator tests
Here we test the combinators. We perform the following tests.
=cut
#==============================================================================
=head2 Frequency
We provide two tests of the Frequency combinator. First, we make
sure that when all of the frequencies are identical the resulting
distribution is complete and uniform. In effect, Frequency behaves
like Elements for this case.
=cut
for ([0..9],["a".."j"])
{
my $g = Frequency( map {[1,Unit($_)]} @$_ );
complete_and_uniform_ok($g, "Frequency(all freqs = 1, @$_)", $_);
}
=pod
Second, we test that the frequencies are actually respected. When a
sub-generator has a zero frequency, it should never be selected. We
test this by creating a "yes" generator with frequency 1 and a "no"
generator with frequency 0. We make sure that the combined
Frequency generator generates only "yes" values. We run two variants
of this test, one for each ordering of the two sub-generators.
=cut
for ('([[0,Unit("no")],[1,Unit("yes")]])',
'([[1,Unit("yes")],[0,Unit("no")]])')
{
my $g = Frequency( @{eval $_} );
my @yesses = grep { $_ eq "yes" } map {$g->generate} 1..1000;
is(scalar @yesses, 1000, "Frequency$_ generates only 'yes'");
}
=pod
Third, we check to make sure the pre-flight checks catch bad arguments.
=cut
like( eval { Frequency() } || $@,
qr/at least one frequency/,
"pre-flight: Frequency() caught"
);
like( eval { Frequency([0,Bool]) } || $@,
qr/at least one frequency.*greater than zero/,
"pre-flight: Frequency([0,Bool]) caught"
);
like( eval { Frequency([1,Bool],[-1,Bool]) } || $@,
qr/non-negative/,
"pre-flight: Frequency([1,Bool],[-1,Bool]) caught"
);
#==============================================================================
=pod
=head2 Paste
To test the Paste generator, we create six Unit generators that
return, respectively, the values "a".."f". Then we combine them in
two ways via Paste combinators. The first does not use glue and
thus should always generate "abcdef". The second uses the glue "-"
and thus should always generate "a-b-c-d-e-f".
=cut
{
my @gens = map {Unit($_)} "a".."f";
is(Paste(@gens)->generate, "abcdef", "Paste w/o glue as expected");
is(Paste(@gens,glue=>'-')->generate, "a-b-c-d-e-f",
"Paste w/ glue as expected");
}
=pod
We also test to see that Paste handles Lists properly. It should
concatenate the elements of all Lists and then paste them together
with the other arguments.
=cut
{
my $lgen0 = List( Unit(1), length=>0 );
my $lgen4 = List( Unit(1), length=>4 );
is(Paste($lgen0)->generate(5), "", "Paste([empty]) => empty str");
is(Paste($lgen4)->generate(5), "1111",
"Paste([1,1,1,1]) => '1111'");
is(Paste(Unit(0),$lgen0,Unit(2))->generate(5), "02",
"Paste(0,[],2) => '02'");
is(Paste(Unit(0),$lgen4,Unit(2))->generate(5), "011112",
"Paste(0,[1,1,1,1],2) => '011112'");
}
#==============================================================================
=pod
=head2 Sized
We run two tests for the Sized combinator. First, we apply the
constant-sizing C combinator to a sized-Int generator
over the range[-1,100]. If the combinator works properly,
the sizing guidance passed to the Int generator will always be
one, effectively clipping its range to [-1,1]. Thus we
test that the mean of the resulting distribution is 0.
=cut
{
# const sizing of 1 should clip range to [-1,1];
# thus, w/ uniform distribution, mean = 0
my $gstr = 'Sized{1}(Int(sized=>1,range=>[-1,100]))';
my $gen = eval $gstr;
dist_mean_ok($gstr, $gen, [1..200],sub{$_[0]}, 0);
}
=pod
Second, we apply a "size-halving" combinator C
to the same Int generator as before and draw values from
the combined generator for sizing values ranging from [1..200].
We expect the mean of the distribution of generated values
should be equal to (-1 + 100) / 4.
=cut
{
# halving sizing should clip range to [-1,h] where h varies from
# [1/2,100] linearly; thus dist forms a triangle w/ peak height at
# 200/2 = 100 and has mean of (-1 + 100) / 4 = 24.75.
my $gstr = 'Sized{$_[0]/2}(Int(sized=>1,range=>[-1,100]))';
my $gen = eval $gstr;
dist_mean_ok($gstr, $gen, [1..200],sub{$_[0]}, (-1 + 100) / 4);
}
#==============================================================================
=pod
=head2 Each
The Each combinator is just a wrapper around List, so the tests
for it are simple.
=cut
for ( 'Each(Unit(1),Unit(2),Unit(3))' )
{
my $g = eval $_;
is_deeply( $g->generate(1), [1,2,3],
"$_ generates [1,2,3]" );
}
#==============================================================================
=pod
=head2 Apply
Apply, in turn, is built upon Each, so we just make sure that
it gets its own additional functionality right.
=cut
for ( 'Apply(sub{join"/",@_},Unit(1),Unit(2),Unit(3))' )
{
my $g = eval $_;
is( $g->generate(1), "1/2/3", "$_ generates 1/2/3" );
}
#==============================================================================
=pod
=head2 Map
Map is also built upon Each. Again, we just make sure it
adds the correct twist.
=cut
for ( ['(Map {"x" x $_[0]} Unit(1),Unit(2))', '["x","xx"]'] )
{
my ($gstr, $expected) = @$_;
my $g = eval $gstr || die $@;
is_deeply( $g->generate(1), eval $expected, "$gstr generates $expected" );
}
#==============================================================================
=pod
=head2 Concat
Testing Concat is straightforward. We just feed it a few
list generators and make sure it returns the right thing.
=cut
for ( ['Concat', '[]']
, ['Concat(List(Int,length=>0))', '[]']
, ['Concat(Unit("a"))', '["a"]']
, ['Concat(Unit("a"),List(Int,length=>0))', '["a"]']
, ['Concat(List(Int,length=>0))', '[]']
, ['Concat(List(Unit([1]),length=>1))', '[[1]]']
, ['Concat(List(Unit(1),length=>2))', '[1,1]']
, ['Concat(List(Unit(1),length=>2),List(Unit([2]),length=>1))'
,'[1,1,[2]]']
)
{
my ($gstr, $expected) = @$_;
my $g = eval $gstr || die $@;
is_deeply( $g->generate(1), eval $expected, "$gstr generates $expected" );
}
=cut
#==============================================================================
=pod
=head2 Flatten
Testing Flatten is like Concat, except here we must make sure
that the resulting list does not contain any other lists.
=cut
for ( ['Flatten', '[]']
, ['Flatten(Unit([[[[[[[]]]]]]]))', '[]']
, ['Flatten(Unit("a"))', '["a"]']
, ['Flatten(Unit("a"),List(Int,length=>0))', '["a"]']
, ['Flatten(List(Int,length=>0))', '[]']
, ['Flatten(List(Unit([9]),length=>1))', '[9]']
, ['Flatten(List(Unit(9),length=>2))', '[9,9]']
, ['Flatten(List(Unit(9),length=>2),List(Unit([2]),length=>1))'
,'[9,9,2]']
)
{
my ($gstr, $expected) = @$_;
my $g = eval $gstr || die $@;
is_deeply( $g->generate(1), eval $expected, "$gstr generates $expected" );
}
=cut
#==============================================================================
=pod
=head2 ConcatMap
Testing ConcatMap is like testing Concat and Map together. (Who
would have guessed?)
=cut
for ( ['ConcatMap{}', '[]']
, ['ConcatMap{1}Unit(2)', '[1]']
, ['ConcatMap{[1]}Unit(2)', '[1]']
, ['ConcatMap{[@_]}Each(Unit(2),Unit(3))', '[[2,3]]']
, ['ConcatMap{[@_]}Unit(2),Unit(3)', '[2,3]']
, ['ConcatMap{my($a)=@_;$a%2?[$a]:[]}Unit(1),Unit(2),Unit(3)', '[1,3]']
)
{
my ($gstr, $expected) = @$_;
my $g = eval $gstr || die $@;
is_deeply( $g->generate(1), eval $expected, "$gstr generates $expected" );
}
#==============================================================================
=pod
=head2 FlattenMap
Can you see where this is going? FlattenMap is just like Flatten
and Map, together as best friends.
=cut
for ( ['FlattenMap{}', '[]']
, ['FlattenMap{9}Unit(2)', '[9]']
, ['FlattenMap{[8]}Unit(2)', '[8]']
, ['FlattenMap{[[7]]}Unit(2)', '[7]']
, ['FlattenMap{[@_]}Each(Unit(2),Unit(3))', '[2,3]']
, ['FlattenMap{[@_]}Unit(2),Unit([3])', '[2,3]']
, ['FlattenMap{[[[[[9]]]]]}Unit(2),Unit([3])', '[9,9]']
, ['FlattenMap{my($a)=@_;$a%2?[$a]:[]}Unit(9),Unit(2),Unit(3)', '[9,3]']
)
{
my ($gstr, $expected) = @$_;
my $g = eval $gstr || die $@;
is_deeply( $g->generate(1), eval $expected, "$gstr generates $expected" );
}
=cut
#==============================================================================
#==============================================================================
#==============================================================================
# More helpers
=head1 Helper functions
The test suite relies upon a few helper functions.
=head2 sample_distribution_z_score
This function takes an expected mean and a set of data
values. It analyzes the data set to determine its mean M and standard
deviation. Then it computes a z-score for the hypothesis that M is
equal to the expected mean. The return value is the z-score.
=cut
sub sample_distribution_z_score {
my ($expected_mean, $data) = @_;
my ($sum, $ssq, $count) = (0, 0, scalar @$data);
$sum += $_, $ssq += $_**2 for @$data;
my $mean = $sum/$count;
my $numer = $ssq + $count * $mean**2 - 2 * $mean * $sum;
my $s2 = $numer / ($count - 1);
my $stdev = sqrt $s2;
my $sampdev = $stdev / sqrt($count);
my $z_score = ($mean - $expected_mean) / $sampdev;
return $z_score;
}
=pod
=head2 dist_mean_ok
This function is used to determine if the mean of
the distribution of values returned by a generator is
equal to the expected mean. The generator is asked to
generate one value for each element of sizing guidance
given. The resulting values are passed through the given
$numerizer function to convert them into numbers (useful
if you are testing a String or Char generator). The
name you are giving to the whole mean test should be passed
in $name. This is passed to the Test::More C function
which records the result of the test.
=cut
sub dist_mean_ok {
my ($name, $gen, $sizes, $numerizer, $expected_mean) = @_;
my @data = map { $numerizer->($gen->generate($_)) } @$sizes;
my $z = sample_distribution_z_score($expected_mean, \@data);
cmp_ok(abs($z), '<', 3.89, # w/in 99.99% confidence interval
sprintf "$name dist mean is $expected_mean (z-score = %.2f)", $z);
}
=pod
=head2 complete_and_uniform_ok
This function determines whether the given generator $g
returns values that are uniformly distributed across the complete
range of values it is supposed to cover. In order for this test to
function properly the generator must be designed to select from
among ten distinct values. (E.g., Int(range=>[0,9]) is fine but not
Int(range=>[1,100]).) The test draws 10,000 output values from the
generator and then ensures that all ten @$expected_values are
represented in the output and that all ten were selected with
equal probability. The result of the test is reported
via the Test::More C function.
=cut
sub complete_and_uniform_ok {
my ($g, $dist_name, $expected_values) = @_;
die unless @$expected_values == 10;
my %counts;
$counts{$_}++ for map { $g->generate } 1..10_000;
my $test = 0; # assume failure
foreach my $count (values %counts) {
# if the distribution is uniform, the following
# test will succeed with 99.997 percent probability
$test = 875 <= $count && $count <= 1125;
last unless $test;
}
ok($test && grep(defined,@counts{@$expected_values}) == 10,
"$dist_name is complete and uniformly distributed");
}
=head1 AUTHOR
Tom Moertel (tom@moertel.com)
=head1 COPYRIGHT and LICENSE
Copyright (C) 2004 by Thomas G Moertel. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
~~