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