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*/