1: !
  2: !  Simple PETSc Program to test setting error handlers from Fortran
  3: !
  4: #include <petsc/finclude/petscsys.h>
  5: module ex1fmodule
  6:   use petscsys
  7:   implicit none
  8: contains
  9:   subroutine GenerateErr(line, ierr)
 10:     PetscErrorCode ierr
 11:     integer line

 13:     call PetscError(PETSC_COMM_SELF, 1, PETSC_ERROR_INITIAL, 'My error message')
 14:   end

 16:   subroutine MyErrHandler(comm, line, fun, file, n, p, mess, ctx, ierr)
 17:     integer line, n, p
 18:     PetscInt ctx
 19:     PetscErrorCode ierr
 20:     MPIU_Comm comm
 21:     character*(*) fun, file, mess

 23:     write (6, *) 'My error handler ', mess
 24:     call flush (6)
 25:   end
 26: end module ex1fmodule

 28: program main
 29:   use petscsys
 30:   use ex1fmodule
 31:   implicit none
 32:   PetscErrorCode ierr

 34:   PetscCallA(PetscInitialize(ierr))
 35:   PetscCallA(PetscPushErrorHandler(PetscTraceBackErrorHandler, PETSC_NULL_INTEGER, ierr))
 36:   PetscCallA(GenerateErr(__LINE__, ierr))
 37:   PetscCallA(PetscPushErrorHandler(MyErrHandler, PETSC_NULL_INTEGER, ierr))
 38:   PetscCallA(GenerateErr(__LINE__, ierr))
 39:   PetscCallA(PetscPushErrorHandler(PetscAbortErrorHandler, PETSC_NULL_INTEGER, ierr))
 40:   PetscCallA(GenerateErr(__LINE__, ierr))
 41:   PetscCallA(PetscFinalize(ierr))
 42: end

 44: !
 45: !     These test fails on some systems randomly due to the Fortran and C output becoming mixed up,
 46: !     using a Fortran flush after the Fortran print* does not resolve the issue
 47: !
 48: !/*TEST
 49: !
 50: !   test:
 51: !     args: -error_output_stdout
 52: !     TODO: cannot fix
 53: !     filter:Error: grep -E "(My error handler|Operating system error: Cannot allocate memory)" | wc -l
 54: !
 55: !TEST*/