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,'Error message')
 12:       return
 13:       end

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

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

 28:       program main
 29:       use petscsys
 30:       PetscErrorCode ierr
 31:       external       MyErrHandler

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

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