Actual source code: ex1f.F90

  1: !
  2: !  Simple PETSc Program to test setting error handlers from Fortran
  3: !
  4:       subroutine GenerateErr(line,ierr)

  6: #include <petsc/finclude/petscsys.h>
  7:       use petscsys
  8:       PetscErrorCode  ierr
  9:       integer line

 11:       call PetscError(PETSC_COMM_SELF,1,PETSC_ERROR_INITIAL,'My error message')
 12:       end

 14:       subroutine MyErrHandler(comm,line,fun,file,n,p,mess,ctx,ierr)
 15:       use petscsysdef
 16:       integer line,n,p
 17:       PetscInt ctx
 18:       PetscErrorCode ierr
 19:       MPI_Comm comm
 20:       character*(*) fun,file,mess

 22:       write(6,*) 'My error handler ',mess
 23:       call flush(6)
 24:       end

 26:       program main
 27:       use petscsys
 28:       PetscErrorCode ierr
 29:       external       MyErrHandler

 31:       PetscCallA(PetscInitialize(ierr))
 32:       PetscCallA(PetscPushErrorHandler(PetscTraceBackErrorHandler,PETSC_NULL_INTEGER,ierr))
 33:       PetscCallA(GenerateErr(__LINE__,ierr))
 34:       PetscCallA(PetscPushErrorHandler(MyErrHandler,PETSC_NULL_INTEGER,ierr))
 35:       PetscCallA(GenerateErr(__LINE__,ierr))
 36:       PetscCallA(PetscPushErrorHandler(PetscAbortErrorHandler,PETSC_NULL_INTEGER,ierr))
 37:       PetscCallA(GenerateErr(__LINE__,ierr))
 38:       PetscCallA(PetscFinalize(ierr))
 39:       end

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