Skip to content

Commit

Permalink
Merge pull request #606 from galacticusorg/fixHDF5CloseOnError
Browse files Browse the repository at this point in the history 
Fix segfault during HDF5 close on error
  • Loading branch information
@abensonca
abensonca authored Apr 30, 2024
2 parents bb21b7d + 52eaa91 commit dcb628d
Show file tree
Hide file tree
Showing 3 changed files with 48 additions and 106 deletions.
140 changes: 37 additions & 103 deletions source/error.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -103,12 +103,6 @@ subroutine Error_Report_Char(message)
!!{
Display an error message.
!!}
#ifndef UNCLEANEXIT
use :: HDF5_Access , only : hdf5Access
#endif
#ifndef UNCLEANEXIT
use :: HDF5 , only : H5Close_F
#endif
#ifdef USEMPI
use :: MPI , only : MPI_Comm_Rank , MPI_Comm_World
#endif
Expand All @@ -117,9 +111,8 @@ subroutine Error_Report_Char(message)
use :: System_Output, only : stdOutIsATTY
implicit none
character(len=* ), intent(in ) :: message
integer :: error
#ifdef USEMPI
integer :: mpiRank
integer :: mpiRank , error
character(len=128) :: hostName
logical :: flag
#endif
Expand All @@ -141,11 +134,7 @@ subroutine Error_Report_Char(message)
#ifdef UNCLEANEXIT
call Exit(1)
#else
!$ if (.not.hdf5Access%ownedByThread()) &
!$ & call hdf5Access%set ( )
call H5Close_F (error)
call H5Close_C ( )
!$ call hdf5Access%unset( )
call closeHDF5()
#ifdef USEMPI
call MPI_Initialized(flag,error)
if (flag) then
Expand Down Expand Up @@ -256,22 +245,15 @@ subroutine Signal_Handler_SIGINT()
!!{
Handle {\normalfont \ttfamily SIGINT} signals, by flushing all data and then aborting.
!!}
#ifndef UNCLEANEXIT
use :: HDF5_Access , only : hdf5Access
#endif
#ifndef UNCLEANEXIT
use :: HDF5 , only : H5Close_F
#endif
#ifdef USEMPI
use :: MPI_F08 , only : MPI_Comm_Rank , MPI_Comm_World
#endif
!$ use :: OMP_Lib , only : OMP_Get_Thread_Num, OMP_In_Parallel
use :: Display , only : displayBold , displayRed , displayReset
use :: System_Output, only : stdOutIsATTY
implicit none
integer :: error
#ifdef USEMPI
integer :: mpiRank
integer :: mpiRank , error
character(len=128) :: hostName
logical :: flag
#endif
Expand All @@ -287,11 +269,7 @@ subroutine Signal_Handler_SIGINT()
!$ write (0,*) " => Error occurred in master thread"
!$ end if
#ifndef UNCLEANEXIT
!$ if (.not.hdf5Access%ownedByThread()) &
!$ & call hdf5Access%set ( )
call H5Close_F (error)
call H5Close_C ( )
!$ call hdf5Access%unset( )
call closeHDF5()
#endif
call Warn_Review( )
call BackTrace ( )
Expand Down Expand Up @@ -319,22 +297,15 @@ subroutine Signal_Handler_SIGSEGV()
!!{
Handle {\normalfont \ttfamily SIGSEGV} signals, by flushing all data and then aborting.
!!}
#ifndef UNCLEANEXIT
use :: HDF5_Access , only : hdf5Access
#endif
#ifndef UNCLEANEXIT
use :: HDF5 , only : H5Close_F
#endif
#ifdef USEMPI
use :: MPI_F08 , only : MPI_Comm_Rank , MPI_Comm_World
#endif
!$ use :: OMP_Lib , only : OMP_Get_Thread_Num, OMP_In_Parallel
use :: Display , only : displayBold , displayRed , displayReset
use :: System_Output, only : stdOutIsATTY
implicit none
integer :: error
#ifdef USEMPI
integer :: mpiRank
integer :: mpiRank , error
character(len=128) :: hostName
logical :: flag
#endif
Expand All @@ -350,11 +321,7 @@ subroutine Signal_Handler_SIGSEGV()
!$ write (0,*) " => Error occurred in master thread"
!$ end if
#ifndef UNCLEANEXIT
!$ if (.not.hdf5Access%ownedByThread()) &
!$ & call hdf5Access%set ( )
call H5Close_F (error)
call H5Close_C ( )
!$ call hdf5Access%unset( )
call closeHDF5()
#endif
call Warn_Review( )
call BackTrace ( )
Expand Down Expand Up @@ -382,22 +349,15 @@ subroutine Signal_Handler_SIGFPE()
!!{
Handle {\normalfont \ttfamily SIGFPE} signals, by flushing all data and then aborting.
!!}
#ifndef UNCLEANEXIT
use :: HDF5_Access , only : hdf5Access
#endif
#ifndef UNCLEANEXIT
use :: HDF5 , only : H5Close_F
#endif
#ifdef USEMPI
use :: MPI_F08 , only : MPI_Comm_Rank , MPI_Comm_World
#endif
!$ use :: OMP_Lib , only : OMP_Get_Thread_Num, OMP_In_Parallel
use :: Display , only : displayBold , displayRed , displayReset
use :: System_Output, only : stdOutIsATTY
implicit none
integer :: error
#ifdef USEMPI
integer :: mpiRank
integer :: mpiRank , error
character(len=128) :: hostName
logical :: flag
#endif
Expand All @@ -413,11 +373,7 @@ subroutine Signal_Handler_SIGFPE()
!$ write (0,*) " => Error occurred in master thread"
!$ end if
#ifndef UNCLEANEXIT
!$ if (.not.hdf5Access%ownedByThread()) &
!$ & call hdf5Access%set ( )
call H5Close_F (error)
call H5Close_C ( )
!$ call hdf5Access%unset( )
call closeHDF5()
#endif
call Warn_Review( )
call BackTrace ( )
Expand Down Expand Up @@ -445,22 +401,15 @@ subroutine Signal_Handler_SIGBUS()
!!{
Handle {\normalfont \ttfamily SIGBUS} signals, by flushing all data and then aborting.
!!}
#ifndef UNCLEANEXIT
use :: HDF5_Access , only : hdf5Access
#endif
#ifndef UNCLEANEXIT
use :: HDF5 , only : H5Close_F
#endif
#ifdef USEMPI
use :: MPI_F08 , only : MPI_Comm_Rank , MPI_Comm_World
#endif
!$ use :: OMP_Lib , only : OMP_Get_Thread_Num, OMP_In_Parallel
use :: Display , only : displayBold , displayRed , displayReset
use :: System_Output, only : stdOutIsATTY
implicit none
integer :: error
#ifdef USEMPI
integer :: mpiRank
integer :: mpiRank , error
character(len=128) :: hostName
logical :: flag
#endif
Expand All @@ -476,11 +425,7 @@ subroutine Signal_Handler_SIGBUS()
!$ write (0,*) " => Error occurred in master thread"
!$ end if
#ifndef UNCLEANEXIT
!$ if (.not.hdf5Access%ownedByThread()) &
!$ & call hdf5Access%set ( )
call H5Close_F (error)
call H5Close_C ( )
!$ call hdf5Access%unset( )
call closeHDF5()
#endif
call Warn_Review( )
call BackTrace ( )
Expand Down Expand Up @@ -508,22 +453,15 @@ subroutine Signal_Handler_SIGILL()
!!{
Handle {\normalfont \ttfamily SIGILL} signals, by flushing all data and then aborting.
!!}
#ifndef UNCLEANEXIT
use :: HDF5_Access , only : hdf5Access
#endif
#ifndef UNCLEANEXIT
use :: HDF5 , only : H5Close_F
#endif
#ifdef USEMPI
use :: MPI_F08 , only : MPI_Comm_Rank , MPI_Comm_World
#endif
!$ use :: OMP_Lib , only : OMP_Get_Thread_Num, OMP_In_Parallel
use :: Display , only : displayBold , displayRed , displayReset
use :: System_Output, only : stdOutIsATTY
implicit none
integer :: error
#ifdef USEMPI
integer :: mpiRank
integer :: mpiRank , error
character(len=128) :: hostName
logical :: flag
#endif
Expand All @@ -539,11 +477,7 @@ subroutine Signal_Handler_SIGILL()
!$ write (0,*) " => Error occurred in master thread"
!$ end if
#ifndef UNCLEANEXIT
!$ if (.not.hdf5Access%ownedByThread()) &
!$ & call hdf5Access%set ( )
call H5Close_F (error)
call H5Close_C ( )
!$ call hdf5Access%unset( )
call closeHDF5()
#endif
call Warn_Review( )
call BackTrace ( )
Expand Down Expand Up @@ -571,16 +505,9 @@ subroutine Signal_Handler_SIGXCPU()
!!{
Handle {\normalfont \ttfamily SIGXCPU} signals, by flushing all data and then aborting.
!!}
#ifndef UNCLEANEXIT
use :: HDF5_Access , only : hdf5Access
#endif
#ifndef UNCLEANEXIT
use :: HDF5 , only : H5Close_F
#endif
use :: Display , only : displayBold , displayRed, displayReset
use :: System_Output, only : stdOutIsATTY
implicit none
integer :: error

if (stdOutIsATTY()) then
write (0,*) displayRed()//displayBold()//'Galacticus exceeded available CPU time - will try to flush data before exiting.'//displayReset()
Expand All @@ -589,11 +516,7 @@ subroutine Signal_Handler_SIGXCPU()
end if
call Flush(0)
#ifndef UNCLEANEXIT
!$ if (.not.hdf5Access%ownedByThread()) &
!$ & call hdf5Access%set ( )
call H5Close_F (error)
call H5Close_C ( )
!$ call hdf5Access%unset( )
call closeHDF5()
#endif
call Exit(errorStatusXCPU)
return
Expand All @@ -603,12 +526,6 @@ subroutine errorHandlerGSL(reason,file,line,errorNumber) bind(c)
!!{
Handle errors from the GSL library, by flushing all data and then aborting.
!!}
#ifndef UNCLEANEXIT
use :: HDF5_Access , only : hdf5Access
#endif
#ifndef UNCLEANEXIT
use :: HDF5 , only : H5Close_F
#endif
use , intrinsic :: ISO_C_Binding , only : c_char
use :: ISO_Varying_String, only : char
#ifdef USEMPI
Expand All @@ -620,9 +537,8 @@ subroutine errorHandlerGSL(reason,file,line,errorNumber) bind(c)
use :: System_Output , only : stdOutIsATTY
character(c_char), dimension(*) :: file , reason
integer (c_int ), value :: errorNumber, line
integer :: error
#ifdef USEMPI
integer :: mpiRank
integer :: mpiRank , error
character(len=128) :: hostName
logical :: flag
#endif
Expand All @@ -641,11 +557,7 @@ subroutine errorHandlerGSL(reason,file,line,errorNumber) bind(c)
!$ write (0,*) " => Error occurred in master thread"
!$ end if
#ifndef UNCLEANEXIT
!$ if (.not.hdf5Access%ownedByThread()) &
!$ & call hdf5Access%set ( )
call H5Close_F (error)
call H5Close_C ( )
!$ call hdf5Access%unset( )
call closeHDF5()
#endif
call Warn_Review( )
call BackTrace ( )
Expand Down Expand Up @@ -751,4 +663,26 @@ subroutine Error_Wait_Set(errorWaitTimeNew)
return
end subroutine Error_Wait_Set

#ifndef UNCLEANEXIT
subroutine closeHDF5()
!!{
Close HDF5 functionality on error.
!!}
use :: HDF5 , only : H5Close_F
use :: HDF5_Access , only : hdf5Access, hdf5AccessInitialized
implicit none
integer :: error

!$ if (hdf5AccessInitialized) then
!$ if (.not.hdf5Access%ownedByThread()) &
!$ & call hdf5Access%set ( )
call H5Close_F (error)
call H5Close_C ( )
!$ if (hdf5AccessInitialized ) &
!$ & call hdf5Access%unset( )
!$ end if
return
end subroutine closeHDF5
#endif

end module Error
2 changes: 1 addition & 1 deletion source/merger_trees.construct.fully_specified.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -217,7 +217,7 @@ function fullySpecifiedConstructorInternal(fileName,randomNumberGenerator_) resu
if (ioErr /= 0) then
message=var_str("unable to read or parse fully-specified merger tree file ")//"'"//self%fileName//"'"
if (File_Exists(self%fileName)) then
message=message//char(10)//displayGreen()//"HELP:"//displayReset()//" check that the XML in this file is valid (e.g. `xmllint --nout "//self%fileName//"` will display any XML errors"
message=message//char(10)//displayGreen()//"HELP:"//displayReset()//" check that the XML in this file is valid (e.g. `xmllint --noout "//self%fileName//"` will display any XML errors"
else
message=message//" - file does not exist"
end if
Expand Down
12 changes: 10 additions & 2 deletions source/utility.input_parameters.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -313,6 +313,7 @@ function inputParametersConstructorFileChar(fileName,allowedParameterNames,outpu
Constructor for the {\normalfont \ttfamily inputParameters} class from an XML file
specified as a character variable.
!!}
use :: Display , only : displayGreen , displayReset
use :: File_Utilities, only : File_Exists
use :: FoX_dom , only : node
use :: Error , only : Error_Report
Expand All @@ -333,9 +334,16 @@ function inputParametersConstructorFileChar(fileName,allowedParameterNames,outpu
doc => XML_Parse(fileName,iostat=errorStatus)
if (errorStatus /= 0) then
if (File_Exists(fileName)) then
call Error_Report('Unable to parse parameter file: "'//trim(fileName)//'"'//{introspection:location})
call Error_Report( &
& 'Unable to parse parameter file: "'//trim(fileName)//'"'//char(10)// &
& displayGreen()//"HELP:"//displayReset()//" check that the XML in this file is valid (e.g. `xmllint --noout "//trim(fileName)//"` will display any XML errors"// &
& {introspection:location} &
& )
else
call Error_Report('Unable to find parameter file: "' //trim(fileName)//'"'//{introspection:location})
call Error_Report( &
& 'Unable to find parameter file: "' //trim(fileName)//'"'// &
& {introspection:location} &
& )
end if
end if
parameterNode => XML_Get_First_Element_By_Tag_Name( &
Expand Down

0 comments on commit dcb628d

Please sign in to comment.