Actual source code: ex1f.F90

  1: !
  2: !  Simple PETSc Program to test setting error handlers from Fortran
  3: !
  4:       subroutine GenerateErr(line,ierr)

  6: #include <petsc/finclude/petscsys.h>
  7:       use petscsys
  8:       PetscErrorCode  ierr
  9:       integer line

 11:       call PetscError(PETSC_COMM_SELF,1,PETSC_ERROR_INITIAL,'Error message')

 13:       return
 14:       end

 16:       subroutine MyErrHandler(comm,line,fun,file,n,p,mess,ctx,ierr)
 17:       use petscsysdef
 18:       integer line,n,p
 19:       PetscInt ctx
 20:       PetscErrorCode ierr
 21:       MPI_Comm comm
 22:       character*(*) fun,file,mess

 24:       write(6,*) 'My error handler ',mess
 25:       call flush(6)
 26:       return
 27:       end

 29:       program main
 30:       use petscsys
 31:       PetscErrorCode ierr
 32:       external       MyErrHandler

 34:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 35:       if (ierr .ne. 0) then
 36:         write(6,*) 'Unable to initialize PETSc'
 37:         call flush(6)
 38:         stop
 39:       endif

 41:       call PetscPushErrorHandler(PetscTraceBackErrorHandler,PETSC_NULL_INTEGER,ierr)

 43:       call GenerateErr(__LINE__,ierr)

 45:       call PetscPushErrorHandler(MyErrHandler,PETSC_NULL_INTEGER,ierr)

 47:       call GenerateErr(__LINE__,ierr)

 49:       call PetscPushErrorHandler(PetscAbortErrorHandler,PETSC_NULL_INTEGER,ierr)

 51:       call GenerateErr(__LINE__,ierr)

 53:       call PetscFinalize(ierr)
 54:       end

 56: !
 57: !     These test fails on some systems randomly due to the Fortran and C output becoming mixxed up,
 58: !     using a Fortran flush after the Fortran print* does not resolve the issue
 59: !
 60: !/*TEST
 61: !
 62: !   test:
 63: !     args: -error_output_stdout
 64: !     filter:Error: egrep  "(My error handler|Operating system error: Cannot allocate memory)" | wc -l
 65: !
 66: !TEST*/