xref: /petsc/src/sys/tests/ex1f.F90 (revision e7a95102f46630f317be643b805dc1c3f4655aeb)
1c4762a1bSJed Brown!
2c4762a1bSJed Brown!  Simple PETSc Program to test setting error handlers from Fortran
3c4762a1bSJed Brown!
4c4762a1bSJed Brown#include <petsc/finclude/petscsys.h>
5*e7a95102SMartin Diehlmodule ex1f_mod
6c4762a1bSJed Brown  use petscsys
7*e7a95102SMartin Diehl  implicit none
8*e7a95102SMartin Diehlcontains
9*e7a95102SMartin 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
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  end
26*e7a95102SMartin Diehlend module ex1f_mod
27c4762a1bSJed Brown
28c4762a1bSJed Brownprogram main
29c4762a1bSJed Brown  use petscsys
30*e7a95102SMartin Diehl  use ex1f_mod
31*e7a95102SMartin 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