1 package Math
::GSL
::RNG
::Test
;
2 use Math
::GSL
::Test qw
/:all/;
3 use base
q{Test::Class};
5 use Math
::GSL qw
/:all/;
6 use Math
::GSL
::RNG qw
/:all/;
7 use Math
::GSL
::Errno qw
/:all/;
11 sub make_fixture
: Test
(setup
) {
13 $self->{rng
} = gsl_rng_alloc
($gsl_rng_default);
14 gsl_rng_set
( $self->{rng
}, 1 + 9*(int rand) );
17 sub teardown
: Test
(teardown
) {
19 unlink 'rng' if -f
'rng';
21 gsl_rng_free
($self->{rng
});
24 sub GSL_RNG_TYPE
: Tests
{
26 my $type = Math
::GSL
::RNG
::gsl_rng_type
->new;
27 isa_ok
( $type, 'Math::GSL::RNG::gsl_rng_type', 'gsl_rng_type' );
30 sub GSL_RNG_ALLOC
: Tests
{
31 for my $rngtype ( $gsl_rng_random256_bsd, $gsl_rng_knuthran,
32 $gsl_rng_transputer, $gsl_rng_knuthran2002) {
34 eval { $rng = gsl_rng_alloc
($rngtype) };
35 isa_ok
( $rng, 'Math::GSL::RNG');
36 ok
( !$@
,'gsl_rng_alloc');
40 sub GSL_RNG_NEW
: Tests
{
42 $rng = Math
::GSL
::RNG
->new($gsl_rng_knuthran, int 10*rand);
43 isa_ok
($rng, 'Math::GSL::RNG' );
45 $rng = Math
::GSL
::RNG
->new($gsl_rng_knuthran);
46 isa_ok
($rng, 'Math::GSL::RNG' );
48 $rng = Math
::GSL
::RNG
->new;
49 isa_ok
($rng, 'Math::GSL::RNG' );
52 sub GSL_RNG_METHODS
: Tests
{
53 can_ok
('Math::GSL::RNG', qw
/copy get new free/ );
56 sub GSL_RNG_STATE
: Tests
{
57 my $seed = int 10*rand;
58 my $k = 10 + int(100*rand);
59 my $rng1 = Math
::GSL
::RNG
->new($gsl_rng_knuthran, $seed );
61 map { my $x = $rng1->get } (1..$k);
63 my $rng2 = Math
::GSL
::RNG
->new($gsl_rng_knuthran, $seed );
66 my @vals1 = map { $rng1->get } (1..$k);
67 my @vals2 = map { $rng2->get } (1..$k);
69 is_deeply
( [@vals1], [@vals2], "state test, $#vals1 values checked");
72 sub GSL_RNG_GET
: Tests
{
73 my $rng = Math
::GSL
::RNG
->new;
75 ok
( defined $x, '$rng->get' );
78 sub GSL_RNG_NAME
: Tests
{
80 my $name1 = gsl_rng_name
($self->{rng
});
81 ok
( defined $name1 , "\$gsl_rng_default=$name1" );
83 my $rng = Math
::GSL
::RNG
->new;
84 my $name2 = $rng->name;
85 ok
($name1 eq $name2, "\$rng->name == gsl_rng_name = $name2" );
88 sub GSL_RNG_SIZE
: Tests
{
90 my $size = gsl_rng_size
($self->{rng
});
91 ok
( $size > 0, 'gsl_rng_size' );
94 sub GSL_RNG_MIN_AND_MAX
: Tests
{
96 my $rng = $self->{rng
};
97 my ($min,$max) = (gsl_rng_min
($rng), gsl_rng_max
($rng));
98 map { gsl_rng_get
($rng) } (1..int(rand(100)));
99 ok
( defined $min && defined $max
100 && ($min <= $max), 'gsl_rng_min and gsl_rng_max');
103 sub GSL_RNG_NO_MORE_SECRETS
: Tests
{
104 my $seed = 1+int 10*rand;
105 my $k = 10 + int(100*rand);
106 my $rng1 = Math
::GSL
::RNG
->new($gsl_rng_knuthran, $seed );
107 my $rng2 = Math
::GSL
::RNG
->new($gsl_rng_knuthran, $seed );
109 # throw away the first $k values
110 map { $rng1->get && $rng2->get } (1..$k);
112 my ($n1,$n2) = ( $rng1->get , $rng2->get );
113 ok
( $n1 == $n2 , "parrallel state test: $n1 ?= $n2" );
116 sub GSL_RNG_DEFAULT
: Tests
{
120 my $rng = gsl_rng_alloc
($gsl_rng_default);
121 isa_ok
( $rng, 'Math::GSL::RNG', 'gsl_rng_alloc' );
123 eval { gsl_rng_set
($rng, $seed) };
124 isa_ok
( $rng, 'Math::GSL::RNG', 'gsl_rng_set' );
125 ok
( ! $@
, 'gsl_rng_set' );
127 my $rand = gsl_rng_get
($rng);
128 ok
( defined $rand && $rand == 1608637542, 'gsl_rng_get' );
130 my $rng2 = gsl_rng_alloc
($gsl_rng_default);
132 eval { gsl_rng_memcpy
($rng2, $rng) };
133 ok
( ! $@
, 'gsl_rng_memcpy' );
135 eval { Math
::GSL
::RNG
::gsl_rng_free
($rng) };
136 ok
( ! $@
, 'gsl_rng_free' );
139 sub GSL_RNG_FWRITE_FREAD
: Tests
{
141 my $rng = gsl_rng_alloc
($gsl_rng_default);
143 my $fh = gsl_fopen
("rng" , 'w');
144 ok_status
(gsl_rng_fwrite
($fh, $self->{rng
}));
145 ok_status
(gsl_fclose
($fh));
147 $fh = gsl_fopen
("rng", 'r');
148 is
(gsl_rng_fread
($fh, $rng),0);
149 is
(gsl_rng_get
($rng), gsl_rng_get
($self->{rng
}));
150 ok_status
(gsl_fclose
($fh));