xref: /petsc/src/sys/tests/ex1f.F90 (revision 6dd63270497ad23dcf16ae500a87ff2b2a0b7474)
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