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