!-*-f90-*-
!
!  API: Error treatment
!  FIXME: introduction of own error handler requires
!
!> \page "Comments on error handling"
!> Please go to api/error.finc for the API documentation.
!>
!> The error handling subroutines are available from Fortran, with
!> exception of the macros <CODE>GSL_ERROR</CODE> and  <CODE>GSL_ERROR_VAL</CODE>.
!> A user-defined error handler can be defined either in C or using a
!> Fortran function with the <CODE>bind(c)</CODE> attribute. Here is the
!> description of the required interface:
!> <PRE>
!> subroutine errhand(reason, file, line, errno) bind(c)
!>    type(c_ptr), value :: reason, file
!>    integer(c_int), value :: line, errno
!> end subroutine errhand
!> </PRE>
!> An object of type <CODE>fgsl_error_handler_t</CODE> is returned by the
!> constructor <CODE>fgsl_error_handler_init(errhand)</CODE>, which takes
!> a subroutine with the interface described above as its argument.
!> The subroutine <CODE>fgsl_error(reason, file, line, errno)</CODE> works
!> in an analogous manner as the C version. If the Fortran preprocessor is
!> supported, it should be possible to use the macros <CODE>__FILE__</CODE>
!> and <CODE>__LINE__</CODE> in the above call. Once not needed any more, the
!> error handler object can be deallocated by calling the subroutine
!> <CODE>fgsl_error_handler_free</CODE> with itself as its only argument.
!> Note that the function <CODE>fgsl_strerror</CODE> returns a string
!> of length <CODE>fgsl_strmax</CODE>.

  function fgsl_set_error_handler(new_handler)
    type(fgsl_error_handler_t), intent(in) :: new_handler
    type(fgsl_error_handler_t) :: fgsl_set_error_handler
    fgsl_set_error_handler%gsl_error_handler_t = &
         gsl_set_error_handler(new_handler%gsl_error_handler_t)
  end function fgsl_set_error_handler
  function fgsl_set_error_handler_off()
    type(fgsl_error_handler_t) :: fgsl_set_error_handler_off
    fgsl_set_error_handler_off%gsl_error_handler_t = &
         gsl_set_error_handler_off()
  end function fgsl_set_error_handler_off
  function fgsl_strerror(errno)
    integer(fgsl_int), intent(in) :: errno
    character(kind=fgsl_char,len=fgsl_strmax) :: fgsl_strerror
!
    type(c_ptr) :: name
!
!    write(6, *) 'Error is ',errno
    name = gsl_strerror(errno)
    fgsl_strerror = fgsl_name(name)
  end function fgsl_strerror
  subroutine fgsl_error(reason, file, line, errno)
    character(kind=fgsl_char,len=*), intent(in) :: &
         reason, file
    integer(fgsl_int), intent(in) :: line, errno
    character(kind=fgsl_char,len=fgsl_strmax), target :: reason_null, file_null
    if (len(trim(reason)) < fgsl_strmax .and. &
         len(trim(file)) < fgsl_strmax) then
       reason_null = trim(reason) // c_null_char
       file_null = trim(file) // c_null_char
       call gsl_error(c_loc(reason_null), c_loc(file_null), line, errno)
    end if
  end subroutine fgsl_error
  function fgsl_error_handler_status(error_handler_t)
    type(fgsl_error_handler_t), intent(in) :: error_handler_t
    logical :: fgsl_error_handler_status
    fgsl_error_handler_status = .true.
    if (.not. c_associated(error_handler_t%gsl_error_handler_t)) &
         fgsl_error_handler_status = .false.
  end function fgsl_error_handler_status
!
! initialize own error handler
!
  function fgsl_error_handler_init(handler_sr)
    interface
       subroutine handler_sr(reason, file, line, errno) bind(c)
         import :: c_ptr, c_int
         type(c_ptr), value :: reason, file
         integer(c_int), value :: line, errno
       end subroutine handler_sr
    end interface
    type(fgsl_error_handler_t) :: fgsl_error_handler_init
!
    type(c_funptr) :: fptr
    fptr = c_funloc(handler_sr)
    fgsl_error_handler_init%gsl_error_handler_t = fptr
  end function fgsl_error_handler_init