1! 2! Simple PETSc Program to test setting error handlers from Fortran 3! 4#include <petsc/finclude/petscsys.h> 5module ex1fmodule 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 MPIU_Comm comm 21 character*(*) fun, file, mess 22 23 write (6, *) 'My error handler ', mess 24 call flush (6) 25 end 26end module ex1fmodule 27 28program main 29 use petscsys 30 use ex1fmodule 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