1! 2! Simple PETSc Program to test setting error handlers from Fortran 3! 4 subroutine GenerateErr(line,ierr) 5 6#include <petsc/finclude/petscsys.h> 7 use petscsys 8 PetscErrorCode ierr 9 integer line 10 11 call PetscError(PETSC_COMM_SELF,1,PETSC_ERROR_INITIAL,'Error message') 12 return 13 end 14 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 22 23 write(6,*) 'My error handler ',mess 24 call flush(6) 25 return 26 end 27 28 program main 29 use petscsys 30 PetscErrorCode ierr 31 external MyErrHandler 32 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 42 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*/ 54