t/Deriv.t

   1 package Math::GSL::Deriv::Test;
   2 use Math::GSL::Test qw/:all/;
   3 use base 'Test::Class';
   4 use Test::More 'no_plan';
   5 use Math::GSL qw/:all/;
   6 use Math::GSL::Deriv qw/:all/;
   7 use Math::GSL::Errno qw/:all/;
   8 use Test::Exception;
   9 use Data::Dumper;
  10 use strict;
  11 use warnings;
  12
  13 BEGIN{ gsl_set_error_handler_off() };
  14
  15 sub make_fixture : Test(setup) {
  16     my $self = shift;
  17     $self->{gsl_func} = Math::GSL::Deriv::gsl_function_struct->new;
  18 }
  19
  20 sub teardown : Test(teardown) {
  21 }
  22
  23 sub TEST_FUNCTION_STRUCT : Tests {
  24     my $self = shift;
  25
  26     isa_ok( $self->{gsl_func},'Math::GSL::Deriv::gsl_function_struct');
  27 }
  28
  29 sub TEST_DERIV_CENTRAL_DIES : Tests {
  30     my ($x,$h)=(10,0.01);
  31     throws_ok( sub {
  32                gsl_deriv_central( 'IAMNOTACODEREF', $x, $h);
  33            },qr/not a reference value/, 'gsl_deriv_central borks when first arg is not a coderef');
  34 }
  35
  36 sub TEST_DERIV_CENTRAL : Tests {
  37     my ($x,$h)=(10,0.01);
  38     my $self = shift;
  39     my ($status, $result);
  40
  41     ($status, $result) = gsl_deriv_central ( sub { $_[0] ** 3 }, $x, $h,);
  42     ok_status($status);
  43     my $res = abs($result->[0]-3*$x**2);
  44     ok( $res < $result->[1] , sprintf ("gsl_deriv_forward: res=%.18f, abserr=%.18f",$res, $result->[1] ));
  45 }
  46
  47 sub TEST_DERIV_FORWARD : Tests {
  48     my ($x,$h)=(10,0.01);
  49     my $self = shift;
  50     my ($status, $result);
  51
  52     ($status, $result) = gsl_deriv_forward ( sub { 2 * $_[0] ** 2 }, $x, $h,);
  53     ok_status($status);
  54     my $res = abs($result->[0]-4*$x);
  55     ok( $res < $result->[1] , sprintf ("gsl_deriv_forward: res=%.18f, abserr=%.18f",$res, $result->[1] ));
  56 }
  57
  58 sub TEST_DERIV_BACKWARD : Tests {
  59     my ($x,$h)=(10,0.01);
  60     my $self = shift;
  61     my ($status, $result);
  62
  63     ($status, $result) = gsl_deriv_backward ( sub { log $_[0] }, $x, $h,);
  64     ok_status($status);
  65     my $res = abs($result->[0]-1/$x);
  66     ok( $res < $result->[1] , sprintf ("gsl_deriv_backward: res=%.18f, abserr=%.18f",$res, $result->[1] ));
  67 }
  68
  69 sub TEST_DERIV_CENTRAL_CALLS_THE_SUB : Tests {
  70     my ($x,$h)=(10,0.01);
  71     my $self = shift;
  72
  73     throws_ok( sub {
  74                 gsl_deriv_central ( sub { die "CALL ME BACK!"} , $x, $h)
  75             }, qr/CALL ME BACK/, 'gsl_deriv_central can call anon sub' );
  76 }
  77 Test::Class->runtests;