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