program test_fgslerr
!------------------------------------------------------------------------------
! Testing the Fortran error interface to GSL
!------------------------------------------------------------------------------
  use fgsl
  use tmod
  implicit none
!
  integer(fgsl_int), parameter :: num_tests=10
  integer(fgsl_size_t), parameter :: nmax=10
  type(fgsl_error_handler_t) :: std, off, mine
  type(fgsl_interp) :: interp
  integer :: i, nok
  integer(fgsl_int) :: status
  integer(fgsl_size_t) :: index
  character(kind=fgsl_char, len=fgsl_strmax) :: message
  real(fgsl_double), dimension(10) :: xa, ya
  logical :: test_ok, ok(num_tests)
  type(fgsl_vector) :: vec
  type(fgsl_matrix) :: mat
  type(fgsl_wavelet) :: w
  type(fgsl_permutation) :: p
  type(fgsl_combination) :: c
!  write object sizes
  open(20, file='typesizes.out',form='formatted',status='unknown')
  write(20,'(''All sizes in units of C sizeof (Bytes)'')') 
  write(20,'(''Size of fgsl_char   : '',I4)') fgsl_sizeof(fgsl_char_'a')
  write(20,'(''Size of fgsl_int    : '',I4)') fgsl_sizeof(1_fgsl_int)
  write(20,'(''Size of fgsl_long   : '',I4)') fgsl_sizeof(1_fgsl_long)
  write(20,'(''Size of fgsl_size_t : '',I4)') fgsl_sizeof(1_fgsl_size_t)
  write(20,'(''Size of fgsl_float  : '',I4)') fgsl_sizeof(1.0_fgsl_float)
  write(20,'(''Size of fgsl_double : '',I4)') fgsl_sizeof(1.0_fgsl_double)
  write(20,'(''Size of DT fgsl_vector          : '',I4)') fgsl_sizeof(vec)
  write(20,'(''Size of DT fgsl_matrix          : '',I4)') fgsl_sizeof(mat)
  write(20,'(''Size of DT fgsl_permutation     : '',I4)') fgsl_sizeof(p)
  write(20,'(''Size of DT fgsl_combination     : '',I4)') fgsl_sizeof(c)
  write(20,'(''Size of DT fgsl_wavelet         : '',I4)') fgsl_sizeof(w)
  write(20,'(''Size of DT fgsl_interp          : '',I4)') fgsl_sizeof(interp)
  close(20)
!
  ok = .true.
  test_ok = .true.
  nok = 1
! use an interpolation object to test
  do i=1,nmax
     xa(i) = dble(i-1)
     ya(i) = dble(i-1)**3.0_fgsl_double
  end do
!
  std = fgsl_set_error_handler_off()
!
  interp = fgsl_interp_alloc(fgsl_interp_cspline,1_fgsl_size_t)
  if (fgsl_well_defined(interp)) test_ok = .false.
  call testres_toggle('interp_alloc',test_ok,ok,nok)

  interp = fgsl_interp_alloc(fgsl_interp_cspline,nmax)
  status = fgsl_interp_init(interp,xa,ya,1_fgsl_size_t)
  if (status == fgsl_success) then
     test_ok = .false.
  else
     message = fgsl_strerror(status)
!     write(6, *) 'Error message is: ',trim(message)
     if (trim(message) /= 'invalid argument supplied by user') test_ok=.false.
  end if
  call testres_toggle('interp_init',test_ok,ok,nok)
  status = fgsl_interp_init(interp,xa,ya,nmax)
  if (status /= fgsl_success) test_ok = .false.
  call testres_toggle('interp_init_success',test_ok,ok,nok)
!
! own error handler
!
  mine = fgsl_error_handler_init(mine_sr)
  off = fgsl_set_error_handler(mine)
  status = fgsl_interp_init(interp,xa,ya,1_fgsl_size_t)
!  write(6, *) trim(test_message)
  if (trim(test_message) /= 'invalid argument supplied by user') &
       test_ok=.false.
  call testres_toggle('my_error_handler',test_ok,ok,nok)
! need to build with preprocessing for next line
!  call fgsl_error("my_own_call",__FILE__,__LINE__,2)
  call fgsl_error("my_own_call","test_fgslerr.f90",80,2)
  write(6, *) trim(test_message)
  if (trim(test_message) /= 'output range error') &
       test_ok=.false.
  call testres_toggle('my_own_call',test_ok,ok,nok)
!
!
!
  if (all(ok)) then
     write(6, *) 'OK: All tests passed - now check GSL-internal abort ...'
  else
     write(6, *) 'FAIL: Some or all tests failed'
     stop
  end if
!
! Copy back standard handler 
!
  call fgsl_interp_free(interp)
  off = fgsl_set_error_handler(std)
  interp = fgsl_interp_alloc(fgsl_interp_cspline,1_fgsl_size_t)
  
  write(6, *) 'FAIL: Final triggering failed.'

end program test_fgslerr
