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(1) {
  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(1) {
  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(2) {
  37     my $self = shift;
  38     my ($x,$h)=(10,0.01);
  39
  40     my ($status, $val,$err) = gsl_deriv_central ( sub { $_[0] ** 3 }, $x, $h,);
  41     ok_status($status);
  42     my $res = abs($val-3*$x**2);
  43     ok( $res <= $err  , sprintf ("gsl_deriv_forward: res=%.18f, abserr=%.18f",$res, $err ));
  44 }
  45
  46 sub TEST_DERIV_FORWARD : Tests(2) {
  47     my $self = shift;
  48
  49     my ($x,$h)=(10,0.01);
  50     my ($status, $val,$err) = gsl_deriv_forward ( sub { 2 * $_[0] ** 2 }, $x, $h,);
  51     ok_status($status);
  52     my $res = abs($val-4*$x);
  53     ok( $res <= $err , sprintf ("gsl_deriv_forward: res=%.18f, abserr=%.18f",$res, $err ));
  54 }
  55
  56 sub TEST_DERIV_BACKWARD : Tests(2) {
  57     my $self = shift;
  58     my ($x,$h)=(10,0.01);
  59     my ($status, $val, $err) = gsl_deriv_backward ( sub { log $_[0] }, $x, $h,);
  60     ok_status($status);
  61     my $res = abs($val-1/$x);
  62     ok( $res <= $err , sprintf ("gsl_deriv_backward: res=%.18f, abserr=%.18f",$res, $err ));
  63 }
  64
  65 sub TEST_DERIV_CENTRAL_CALLS_THE_SUB : Tests(1) {
  66     my $self = shift;
  67     my ($x,$h)=(10,0.01);
  68
  69     throws_ok( sub {
  70                 gsl_deriv_central ( sub { die "CALL ME BACK!"} , $x, $h)
  71             }, qr/CALL ME BACK/, 'gsl_deriv_central can call anon sub' );
  72 }
  73 Test::Class->runtests;