xref: /petsc/src/sys/tests/ex1f.F90 (revision 749c190bad46ba447444c173d8c7a4080c70750e)
1c4762a1bSJed Brown!
2c4762a1bSJed Brown!  Simple PETSc Program to test setting error handlers from Fortran
3c4762a1bSJed Brown!
4c4762a1bSJed Brown#include <petsc/finclude/petscsys.h>
501fa2b5aSMartin Diehlmodule ex1fmodule
6c4762a1bSJed Brown  use petscsys
7e7a95102SMartin Diehl  implicit none
8e7a95102SMartin Diehlcontains
9e7a95102SMartin Diehl  subroutine GenerateErr(line, ierr)
10c4762a1bSJed Brown    PetscErrorCode ierr
11c4762a1bSJed Brown    integer line
12c4762a1bSJed Brown
138ff741acSBarry Smith    call PetscError(PETSC_COMM_SELF, 1, PETSC_ERROR_INITIAL, 'My error message')
14c4762a1bSJed Brown  end
15c4762a1bSJed Brown
16c4762a1bSJed Brown  subroutine MyErrHandler(comm, line, fun, file, n, p, mess, ctx, ierr)
17c4762a1bSJed Brown    integer line, n, p
18c4762a1bSJed Brown    PetscInt ctx
19c4762a1bSJed Brown    PetscErrorCode ierr
20*b06eb4cdSBarry Smith    MPIU_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  end
2601fa2b5aSMartin Diehlend module ex1fmodule
27c4762a1bSJed Brown
28c4762a1bSJed Brownprogram main
29c4762a1bSJed Brown  use petscsys
3001fa2b5aSMartin Diehl  use ex1fmodule
31e7a95102SMartin Diehl  implicit none
32c4762a1bSJed Brown  PetscErrorCode ierr
33c4762a1bSJed Brown
34f8402805SBarry Smith  PetscCallA(PetscInitialize(ierr))
35f8402805SBarry Smith  PetscCallA(PetscPushErrorHandler(PetscTraceBackErrorHandler, PETSC_NULL_INTEGER, ierr))
36f8402805SBarry Smith  PetscCallA(GenerateErr(__LINE__, ierr))
37f8402805SBarry Smith  PetscCallA(PetscPushErrorHandler(MyErrHandler, PETSC_NULL_INTEGER, ierr))
38f8402805SBarry Smith  PetscCallA(GenerateErr(__LINE__, ierr))
39f8402805SBarry Smith  PetscCallA(PetscPushErrorHandler(PetscAbortErrorHandler, PETSC_NULL_INTEGER, ierr))
40f8402805SBarry Smith  PetscCallA(GenerateErr(__LINE__, ierr))
41f8402805SBarry Smith  PetscCallA(PetscFinalize(ierr))
42c4762a1bSJed Brownend
43c4762a1bSJed Brown
44c4762a1bSJed Brown!
45f8402805SBarry Smith!     These test fails on some systems randomly due to the Fortran and C output becoming mixed up,
46c4762a1bSJed Brown!     using a Fortran flush after the Fortran print* does not resolve the issue
47c4762a1bSJed Brown!
48c4762a1bSJed Brown!/*TEST
49c4762a1bSJed Brown!
50c4762a1bSJed Brown!   test:
51c4762a1bSJed Brown!     args: -error_output_stdout
52ce78bad3SBarry Smith!     TODO: cannot fix
5330db38ddSPierre Jolivet!     filter:Error: grep -E "(My error handler|Operating system error: Cannot allocate memory)" | wc -l
54c4762a1bSJed Brown!
55c4762a1bSJed Brown!TEST*/
56