ESTABLISHQQ

Module

USE IFESTABLISH

result = ESTABLISHQQ (handler_routine,context,prev_handler,prev_context)

Results

The result type for ESTABLISHQQ is LOGICAL(4). It indicates whether the handler was successfully established. .TRUE. means it was established successfully; .FALSE. means it was not.

The handler function is called when an error occurs. The result for the handler is set by your code in the handler. .TRUE. means that the error has been handled and the application should not issue an error message. .FALSE. means that the application should issue an error message and continue as if there had never been a handler.

After you use ESTABLISHQQ to specify an error handler function and an error occurs, the handler function is called with the following input arguments. They are set up by the RTL when it calls the handler function:

Handler Function Syntax:

result = Handler_Function (error_code, continuable, message_string, context)

Handler_Function is a function you supply that has a compatible interface. It must use the Intel® Fortran compiler defaults for calling mechanism and argument passing. When the Intel Fortran Run-Time Library detects an error, it first calls your handler function with the following arguments:

The function result of the handler function is type LOGICAL(4). The handler function should return .TRUE. if it successfully handled the error; otherwise, .FALSE..

If the handler function returns .TRUE. and the error is continuable, execution of the program continues. If the handler function returns .FALSE., normal error processing is performed, such as message output to the user and possible program termination.

The handler function can be written in any language, but it must follow the Intel Fortran conventions. Note that for argument message_string, an address-sized length is passed by value after argument context.

If you want to handle errors using a C/C++ handler, use the ISO_C_BINDINGS module features to call the C/C++ routine.

Example

! Compile with "-fpe0 -check bounds".
!
program example
use ifestablish
implicit none
    
     procedure(establishqq_handler), pointer :: old_handler_1
     procedure(establishqq_handler), pointer :: old_handler_2
     procedure(establishqq_handler), pointer :: old_handler_3
     procedure(establishqq_handler)          :: my_handler_1
     procedure(establishqq_handler)          :: my_handler_2
     procedure(establishqq_handler)          :: my_handler_3
  
     logical                 :: ret
     integer(INT_PTR_KIND()) :: old_context, my_context = 0
     real,    volatile       :: x,y,z
     integer, volatile       :: i, eleven, a(10)

     my_context = 1
     eleven = 11

     ! Test that handlers can be established and restored.
     !
     old_handler_1 => null()
     print *, "== Establish first handler"
     ret = ESTABLISHQQ(my_handler_1, my_context, old_handler_1, old_context)

     if (associated(old_handler_1)) then
         print *, "** Unexpected old handler on first ESTABLISH **"
         ret =  old_handler_1(100, .true., "call number one", 1 )
         print *, "back from call of old handler with", ret
     else
         print *,"== Got expected NULL old handler"
     end if

     print *,"== Violate array bounds; expect first handler"
     i = a(eleven)

     ! Establish second handler
     !
     old_handler_2 => null()
     print *, "== Establish second handler"
     ret = ESTABLISHQQ(my_handler_2, my_context, old_handler_2, old_context)

     if (associated(old_handler_2)) then
         print *, "== Expect first handler as old handler"
         ret =  old_handler_2(100, .true., "call number one", 1 )
     else
         print *,"** Unexpectedly didn't get first handler as old handler **"
     end if

     print *,"== Violate array bounds; expect second handler"
     i = a(eleven)

     ! Establish third handler
     !
     old_handler_3 => null()
     print *, "== Establish third handler"
     ret = ESTABLISHQQ(my_handler_3, my_context, old_handler_3, old_context)
     !print *, "Got return value ", ret, "old context", old_context

     if (associated(old_handler_3)) then
         print *, "== Expect second handler as old handler"
         ret =  old_handler_3(100, .true., "call number one", 1 )
         !print *, "back from call of old handler with", ret

     else
         print *,"** Unexpectedly didn't get second handler as old handler **"
     end if

     print *,"== Violate array bounds; expect third handler"
     i = a(eleven)

     ! Put back old handlers in stack-wise order, testing.
     !
    ret = ESTABLISHQQ(old_handler_3, old_context)
     print *,"== Violate array bounds; expect second handler"
     i = a(eleven)

     ret = ESTABLISHQQ(old_handler_2, old_context)
     print *,"== Violate array bounds; expect first handler"
     i = a(eleven)

     ret = ESTABLISHQQ(old_handler_1, old_context)
     print *,"== Violate array bounds; expect no handler and exit"
     i = a(eleven)
end

function my_handler_1 (error_code, continuable, message_string, context)
     use, intrinsic :: iso_c_binding
     implicit none
     logical :: my_handler_1
     !DEC$ ATTRIBUTES DEFAULT :: my_handler_1

     ! Arguments
     !
     integer, intent(in) :: error_code               ! RTL error code from IOSTAT table
     logical, intent(in) :: continuable              ! True if condition is continuable
     character(*), intent(in) :: message_string      ! Formatted message string a la ERRMSG/IOMSG
     integer(INT_PTR_KIND()), intent(in) :: context    ! Address-sized integer passed in to call 
                                                       ! ESTABLISHQQ, for whatever purpose
                                                       ! the programmer desires
                                                                               
     my_handler_1 = .TRUE. ! Continue by default

     if (context == 1) then
         print *, "    Handler 1, continue"

     else if (context == 2) then
         print *, "    Handler 1, continue"

     else if (context == 3) then
         print *, "    Handler 1, code should be 73: ", error_code
         if (continuable) then
             print *,"        - is continuable (** an error! **)"
         else
             print *,"        - not continuable"
  end if
         ! We will return .TRUE., asking to continue, but because this is not
         ! a continuable error, the application will exit.

      else
         print *, "    ** Error -- wrong context value"
      end if

      return

end function my_handler_1

function my_handler_2 (error_code, continuable, message_string, context)
     use, intrinsic :: iso_c_binding
     implicit none
     logical :: my_handler_2
     !DEC$ ATTRIBUTES DEFAULT :: my_handler_2

     ! Arguments
     !
     integer, intent(in) :: error_code             ! RTL error code from IOSTAT table
     logical, intent(in) :: continuable            ! True if condition is continuable
     character(*), intent(in) :: message_string    ! Formatted message string a la ERRMSG/IOMSG
     integer(INT_PTR_KIND()), intent(in) :: context    ! Address-sized integer passed in to call 
                                                       ! ESTABLISHQQ, for whatever purpose
                                                       ! the programmer desires
     if (context == 1) then
         print *,"    Handler 2, continue"
         my_handler_2 = .TRUE. ! Continue

     else if (context == 2) then
         print *, "    Handler 2, exit"
         my_handler_2 = .FALSE. ! Exit
     end if

     return
end function my_handler_2

function my_handler_3 (error_code, continuable, message_string, context)
     use, intrinsic :: iso_c_binding
     implicit none
     logical :: my_handler_3
     !DEC$ ATTRIBUTES DEFAULT :: my_handler_3

     ! Arguments
     !
     logical :: my_handler_3
     integer, intent(in) :: error_code             ! RTL error code from IOSTAT table
     logical, intent(in) :: continuable            ! True if condition is continuable
     character(*), intent(in) :: message_string    ! Formatted message string a la ERRMSG/IOMSG
     integer(INT_PTR_KIND()), intent(in) :: context    ! Address-sized integer passed in to call 
                                                       ! ESTABLISHQQ, for whatever purpose
                                                       ! the programmer desires     
     if (context == 1) then
         print *,"    Handler 3, continue"
     else if (context == 2) then
         print *, "    Handler 3, error is ", error_code, message_string
     end if

     my_handler_3 = .TRUE. ! Continue
     return

end function my_handler_3