ferror.f90

! ferror.f90
 
 
! ------------------------------------------------------------------------------
 
module ferror
    use, intrinsic :: iso_fortran_env, only : int32
    implicit none
    private
    public :: errors
    public :: error_callback
 
    type :: errors
        character(len = 256), private :: m_fname = "error_log.txt"
        logical, private :: m_foundError = .false.
        logical, private :: m_foundWarning = .false.
        integer(int32), private :: m_errorFlag = 0
        integer(int32), private :: m_warningFlag = 0
        logical, private :: m_exitOnError = .true.
        logical, private :: m_suppressPrinting = .false.
        character(len = :), private, allocatable :: m_errorMessage
        character(len = :), private, allocatable :: m_warningMessage
        character(len = :), private, allocatable :: m_eFunName
        character(len = :), private, allocatable :: m_wFunName
        procedure(error_callback), private, pointer, pass :: m_errCleanUp => null()
    contains
        procedure, public :: get_log_filename => er_get_log_filename
 
        procedure, public :: set_log_filename => er_set_log_filename
 
        procedure, public :: report_error => er_report_error
 
        procedure, public :: report_warning => er_report_warning
        
        procedure, public :: log_error => er_log_error
        
        procedure, public :: has_error_occurred => er_has_error_occurred
        
        procedure, public :: reset_error_status => er_reset_error_status
        
        procedure, public :: has_warning_occurred => er_has_warning_occurred
        
        procedure, public :: reset_warning_status => er_reset_warning_status
 
        procedure, public :: get_error_flag => er_get_error_flag
        
        procedure, public :: get_warning_flag => er_get_warning_flag
        
        procedure, public :: get_exit_on_error => er_get_exit_on_error
        
        procedure, public :: set_exit_on_error => er_set_exit_on_error
        
        procedure, public :: get_suppress_printing => er_get_suppress_printing
        
        procedure, public :: set_suppress_printing => er_set_suppress_printing
        
        procedure, public :: get_error_message => er_get_err_msg
        
        procedure, public :: get_warning_message => er_get_warning_msg
        
        procedure, public :: get_error_fcn_name => er_get_err_fcn
        
        procedure, public :: get_warning_fcn_name => er_get_warning_fcn
        
        procedure, public :: get_clean_up_routine => er_get_err_fcn_ptr
        
        procedure, public :: set_clean_up_routine => er_set_err_fcn_ptr
        
    end type
 
    interface
 
        subroutine error_callback(err, obj)
            import errors
            class(errors), intent(in) :: err
            class(*), intent(inout) :: obj
        end subroutine
    end interface
 
    ! ferror_implementation.f90
    interface
        pure module function er_get_log_filename(this) result(str)
            class(errors), intent(in) :: this
            character(len = :), allocatable :: str
        end function
 
        module subroutine er_set_log_filename(this, str)
            class(errors), intent(inout) :: this
            character(len = *), intent(in) :: str
            integer(int32) :: n
        end subroutine
 
        module subroutine er_report_error(this, fcn, msg, flag, obj)
            class(errors), intent(inout) :: this
            character(len = *), intent(in) :: fcn, msg
            integer(int32), intent(in) :: flag
            class(*), intent(inout), optional :: obj
        end subroutine
 
        module subroutine er_report_warning(this, fcn, msg, flag)
            class(errors), intent(inout) :: this
            character(len = *), intent(in) :: fcn, msg
            integer(int32), intent(in) :: flag
        end subroutine
 
        module subroutine er_log_error(this, fcn, msg, flag)
            class(errors), intent(in) :: this
            character(len = *), intent(in) :: fcn, msg
            integer(int32), intent(in) :: flag
        end subroutine
 
        pure module function er_has_error_occurred(this) result(x)
            class(errors), intent(in) :: this
            logical :: x
        end function
 
        module subroutine er_reset_error_status(this)
            class(errors), intent(inout) :: this
        end subroutine
 
        pure module function er_has_warning_occurred(this) result(x)
            class(errors), intent(in) :: this
            logical :: x
        end function
 
        module subroutine er_reset_warning_status(this)
            class(errors), intent(inout) :: this
        end subroutine
 
        pure module function er_get_error_flag(this) result(x)
            class(errors), intent(in) :: this
            integer(int32) :: x
        end function
 
        pure module function er_get_warning_flag(this) result(x)
            class(errors), intent(in) :: this
            integer(int32) :: x
        end function
 
        pure module function er_get_exit_on_error(this) result(x)
            class(errors), intent(in) :: this
            logical :: x
        end function
 
        module subroutine er_set_exit_on_error(this, x)
            class(errors), intent(inout) :: this
            logical, intent(in) :: x
        end subroutine
 
        pure module function er_get_suppress_printing(this) result(x)
            class(errors), intent(in) :: this
            logical :: x
        end function
 
        module subroutine er_set_suppress_printing(this, x)
            class(errors), intent(inout) :: this
            logical, intent(in) :: x
        end subroutine
 
        module function er_get_err_msg(this) result(msg)
            class(errors), intent(in) :: this
            character(len = :), allocatable :: msg
            integer(int32) :: n
        end function
 
        module function er_get_warning_msg(this) result(msg)
            class(errors), intent(in) :: this
            character(len = :), allocatable :: msg
            integer(int32) :: n
        end function
 
        module function er_get_err_fcn(this) result(fcn)
            class(errors), intent(in) :: this
            character(len = :), allocatable :: fcn
            integer(int32) :: n
        end function
 
        module function er_get_warning_fcn(this) result(fcn)
            class(errors), intent(in) :: this
            character(len = :), allocatable :: fcn
            integer(int32) :: n
        end function
 
        module subroutine er_get_err_fcn_ptr(this, ptr)
            class(errors), intent(in) :: this
            procedure(error_callback), intent(out), pointer :: ptr
        end subroutine
 
        module subroutine er_set_err_fcn_ptr(this, ptr)
            class(errors), intent(inout) :: this
            procedure(error_callback), intent(in), pointer :: ptr
        end subroutine
    end interface
 
! ------------------------------------------------------------------------------
end module