1! 2! Simple PETSc Program to test setting error handlers from Fortran 3! 4#include <petsc/finclude/petscsys.h> 5 subroutine GenerateErr(line, ierr) 6 use petscsys 7 PetscErrorCode ierr 8 integer line 9 10 call PetscError(PETSC_COMM_SELF, 1, PETSC_ERROR_INITIAL, 'My error message') 11 end 12 13 subroutine MyErrHandler(comm, line, fun, file, n, p, mess, ctx, ierr) 14 use petscsysdef 15 integer line, n, p 16 PetscInt ctx 17 PetscErrorCode ierr 18 MPI_Comm comm 19 character*(*) fun, file, mess 20 21 write (6, *) 'My error handler ', mess 22 call flush (6) 23 end 24 25 program main 26 use petscsys 27 PetscErrorCode ierr 28 external MyErrHandler 29 30 PetscCallA(PetscInitialize(ierr)) 31 PetscCallA(PetscPushErrorHandler(PetscTraceBackErrorHandler, PETSC_NULL_INTEGER, ierr)) 32 PetscCallA(GenerateErr(__LINE__, ierr)) 33 PetscCallA(PetscPushErrorHandler(MyErrHandler, PETSC_NULL_INTEGER, ierr)) 34 PetscCallA(GenerateErr(__LINE__, ierr)) 35 PetscCallA(PetscPushErrorHandler(PetscAbortErrorHandler, PETSC_NULL_INTEGER, ierr)) 36 PetscCallA(GenerateErr(__LINE__, ierr)) 37 PetscCallA(PetscFinalize(ierr)) 38 end 39 40! 41! These test fails on some systems randomly due to the Fortran and C output becoming mixed up, 42! using a Fortran flush after the Fortran print* does not resolve the issue 43! 44!/*TEST 45! 46! test: 47! args: -error_output_stdout 48! TODO: cannot fix 49! filter:Error: grep -E "(My error handler|Operating system error: Cannot allocate memory)" | wc -l 50! 51!TEST*/ 52