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 13 return 14 end 15 16 subroutine MyErrHandler(comm,line,fun,file,n,p,mess,ctx,ierr) 17 use petscsysdef 18 integer line,n,p 19 PetscInt ctx 20 PetscErrorCode ierr 21 MPI_Comm comm 22 character*(*) fun,file,mess 23 24 write(6,*) 'My error handler ',mess 25 call flush(6) 26 return 27 end 28 29 program main 30 use petscsys 31 PetscErrorCode ierr 32 external MyErrHandler 33 34 call PetscInitialize(PETSC_NULL_CHARACTER,ierr) 35 if (ierr .ne. 0) then 36 write(6,*) 'Unable to initialize PETSc' 37 call flush(6) 38 stop 39 endif 40 41 call PetscPushErrorHandler(PetscTraceBackErrorHandler,PETSC_NULL_INTEGER,ierr) 42 43 call GenerateErr(__LINE__,ierr) 44 45 call PetscPushErrorHandler(MyErrHandler,PETSC_NULL_INTEGER,ierr) 46 47 call GenerateErr(__LINE__,ierr) 48 49 call PetscPushErrorHandler(PetscAbortErrorHandler,PETSC_NULL_INTEGER,ierr) 50 51 call GenerateErr(__LINE__,ierr) 52 53 call PetscFinalize(ierr) 54 end 55 56! 57! These test fails on some systems randomly due to the Fortran and C output becoming mixxed up, 58! using a Fortran flush after the Fortran print* does not resolve the issue 59! 60!/*TEST 61! 62! test: 63! args: -error_output_stdout 64! filter:Error: egrep "(My error handler|Operating system error: Cannot allocate memory)" | wc -l 65! 66!TEST*/ 67