1 package Math::GSL::RNG::Test;
2 use base q{Test::Class};
3 use Test::More tests => 32;
4 use Math::GSL qw/:all/;
5 use Math::GSL::RNG qw/:all/;
6 use Math::GSL::Test 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(2) {
73 my $rng = Math::GSL::RNG->new;
75 ok( defined $x, '$rng->get' );
76 my @values = $rng->get(10);
77 ok( @values == 10, 'got 10 values from get->(10)');
80 sub GSL_RNG_NAME : Tests {
82 my $name1 = gsl_rng_name($self->{rng});
83 ok( defined $name1 , "\$gsl_rng_default=$name1" );
85 my $rng = Math::GSL::RNG->new;
86 my $name2 = $rng->name;
87 ok($name1 eq $name2, "\$rng->name == gsl_rng_name = $name2" );
90 sub GSL_RNG_SIZE : Tests {
92 my $size = gsl_rng_size($self->{rng});
93 ok( $size > 0, 'gsl_rng_size' );
96 sub GSL_RNG_MIN_AND_MAX : Tests {
98 my $rng = $self->{rng};
99 my ($min,$max) = (gsl_rng_min($rng), gsl_rng_max($rng));
100 map { gsl_rng_get($rng) } (1..int(rand(100)));
101 ok( defined $min && defined $max
102 && ($min <= $max), 'gsl_rng_min and gsl_rng_max');
105 sub GSL_RNG_NO_MORE_SECRETS : Tests {
106 my $seed = 1+int 10*rand;
107 my $k = 10 + int(100*rand);
108 my $rng1 = Math::GSL::RNG->new($gsl_rng_knuthran, $seed );
109 my $rng2 = Math::GSL::RNG->new($gsl_rng_knuthran, $seed );
111 # throw away the first $k values
112 map { $rng1->get && $rng2->get } (1..$k);
114 my ($n1,$n2) = ( $rng1->get , $rng2->get );
115 ok( $n1 == $n2 , "parrallel state test: $n1 ?= $n2" );
118 sub GSL_RNG_DEFAULT : Tests {
122 my $rng = gsl_rng_alloc($gsl_rng_default);
123 isa_ok( $rng, 'Math::GSL::RNG', 'gsl_rng_alloc' );
125 eval { gsl_rng_set($rng, $seed) };
126 isa_ok( $rng, 'Math::GSL::RNG', 'gsl_rng_set' );
127 ok( ! $@, 'gsl_rng_set' );
129 my $rand = gsl_rng_get($rng);
130 ok( defined $rand && $rand == 1608637542, 'gsl_rng_get' );
132 my $rng2 = gsl_rng_alloc($gsl_rng_default);
134 eval { gsl_rng_memcpy($rng2, $rng) };
135 ok ( ! $@, 'gsl_rng_memcpy' );
137 eval { Math::GSL::RNG::gsl_rng_free($rng) };
138 ok( ! $@, 'gsl_rng_free' );
141 sub GSL_RNG_FWRITE_FREAD : Tests {
143 my $rng = gsl_rng_alloc($gsl_rng_default);
145 my $fh = gsl_fopen("rng" , 'w');
146 ok_status(gsl_rng_fwrite($fh, $self->{rng}));
147 ok_status(gsl_fclose($fh));
149 $fh = gsl_fopen("rng", 'r');
150 is(gsl_rng_fread($fh, $rng),0);
151 is(gsl_rng_get($rng), gsl_rng_get($self->{rng}));
152 ok_status(gsl_fclose($fh));
154 Test::Class->runtests;