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, 'My error message') 12 end 13 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 21 22 write (6, *) 'My error handler ', mess 23 call flush (6) 24 end 25 26 program main 27 use petscsys 28 PetscErrorCode ierr 29 external MyErrHandler 30 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 40 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! TODO: cannot fix 50! filter:Error: grep -E "(My error handler|Operating system error: Cannot allocate memory)" | wc -l 51! 52!TEST*/ 53