1package Math::GSL::Spline::Test; 2use base 'Test::Class'; 3use Test::More tests => 38; 4use Math::GSL::Errno qw/:all/; 5use Math::GSL::Test qw/:all/; 6use Math::GSL::Spline qw/:all/; 7use Math::GSL::Interp qw/:all/; 8use Test::Exception; 9use Data::Dumper; 10use strict; 11use warnings; 12 13BEGIN{ gsl_set_error_handler_off() }; 14 15sub make_fixture : Test(setup) { 16 my $self = shift; 17 $self->{spline} = gsl_spline_alloc($gsl_interp_linear,100); 18} 19 20sub teardown : Test(teardown) { 21} 22sub TEST_FREE : Test { 23 my $self = shift; 24 25 ## Seems that early versions do not clear $! 26 $! = undef if $] <= 5.008009; 27 28 gsl_spline_free($self->{spline}); 29 30 ok(!$@ && !$! && !$?,'gsl_spline_free'); 31} 32sub TEST_MIN_SIZE : Test { 33 my $self = shift; 34 cmp_ok(2,'==',gsl_spline_min_size($self->{spline}),'min_size'); 35} 36sub TEST_NAME : Test { 37 my $self = shift; 38 my $spline = $self->{spline}; 39 cmp_ok('linear', 'eq' , gsl_spline_name($spline)); 40} 41sub TEST_ALLOC : Tests { 42 isa_ok(gsl_spline_alloc($_,100), 'Math::GSL::Spline') for ( 43 $gsl_interp_linear, 44 $gsl_interp_polynomial, 45 $gsl_interp_cspline, 46 $gsl_interp_cspline_periodic, 47 $gsl_interp_akima, 48 $gsl_interp_akima_periodic); 49} 50 51sub MULTIPLE_TESTS : Tests { 52 my $a = gsl_interp_accel_alloc (); 53 my $spline = gsl_spline_alloc ($gsl_interp_polynomial, 4); 54 my $data_x = [ 0.0, 1.0, 2.0, 3.0 ]; 55 my $data_y = [ 0.0, 1.0, 2.0, 3.0 ]; 56 ok_status(gsl_spline_init($spline, $data_x, $data_y, 4), $GSL_SUCCESS); 57 my $test_x = [ 0.0, 0.5, 1.0, 1.5, 2.5, 3.0 ]; 58 my $test_y = [ 0.0, 0.5, 1.0, 1.5, 2.5, 3.0 ]; 59 my $test_dy = [ 1.0, 1.0, 1.0, 1.0, 1.0, 1.0 ]; 60 my $test_iy = [ 0.0, 0.125, 0.5, 9.0/8.0, 25.0/8.0, 9.0/2.0 ]; 61 62 for my $i (0.. 3) { 63 my $x = $test_x->[$i]; 64 my ($s1, $y) = gsl_spline_eval_e ($spline,$x, $a); 65 my ($s2, $deriv) = gsl_spline_eval_deriv_e ($spline, $x, $a); 66 my ($s3, $integ) = gsl_spline_eval_integ_e ($spline, $test_x->[0], $x, $a); 67 68 ok_status($s1); 69 ok_status($s2); 70 ok_status($s3); 71 72 ok_similar([$y, $deriv, $integ], [$test_y->[$i], $test_dy->[$i], $test_iy->[$i]], "eval_e, derive_e and integ_e",1e-10); 73 74 my $diff_y = $y - $test_y->[$i]; 75 my $diff_deriv = $deriv - $test_dy->[$i]; 76 my $diff_integ = $integ - $test_iy->[$i]; 77 ok( abs($diff_y) < 1e-10, "diff_y"); 78 ok( abs($diff_deriv) < 1e-10, "diff_deriv"); 79 ok( abs($diff_integ) < 1e-10, "diff_integ"); 80 } 81 gsl_interp_accel_free ($a); 82 gsl_spline_free ($spline); 83} 84 85Test::Class->runtests; 86