Skip to content

Commit

Permalink
debugging
Browse files Browse the repository at this point in the history
  • Loading branch information
@brtnfld
brtnfld committed Feb 20, 2024
1 parent 63a9115 commit 3861b97
Show file tree
Hide file tree
Showing 3 changed files with 183 additions and 9 deletions.
161 changes: 153 additions & 8 deletions fortran/src/H5Eff.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,8 +34,7 @@
! to the Windows dll file 'hdf5_fortrandll.def.in' in the fortran/src directory.
! This is needed for Windows based operating systems.
!
! MISSING: H5Eauto_is_v2, H5Eclose_stack, H5Ecreate_stack
! H5Eget_auto2, H5Eget_current_stack, H5Epop, H5Eset_current_stack
! MISSING: H5Eauto_is_v2, H5Eget_auto2

MODULE H5E

Expand Down Expand Up @@ -707,10 +706,11 @@ SUBROUTINE H5Eget_class_name_f(class_id, name, hdferr, size)
INTERFACE
INTEGER(SIZE_T) FUNCTION H5Eget_class_name(class_id, name, size) &
BIND(C,NAME='H5Eget_class_name')
IMPORT :: C_PTR
IMPORT :: C_PTR, C_CHAR
IMPORT :: HID_T, SIZE_T
IMPLICIT NONE
INTEGER(HID_T) , VALUE :: class_id
! CHARACTER(KIND=C_CHAR,LEN=1), DIMENSION(*) :: name
TYPE(C_PTR) , VALUE :: name
INTEGER(SIZE_T), VALUE :: size
END FUNCTION H5Eget_class_name
Expand All @@ -732,16 +732,19 @@ END FUNCTION H5Eget_class_name

IF(name_cp_sz.EQ.0) name_cp_sz = LEN(name)

ALLOCATE(c_name(1:name_cp_sz+1), stat=hdferr)
ALLOCATE(c_name(1:name_cp_sz+2), stat=hdferr)
IF (hdferr .NE. 0) THEN
hdferr = -1
RETURN
ENDIF
f_ptr = C_LOC(c_name(1)(1:1))
f_ptr = C_LOC(c_name)
PRINT*,'lkjdsf',name_cp_sz, name_cp_sz+1_SIZE_T
c_size = H5Eget_class_name(class_id, f_ptr, name_cp_sz+1)

CALL HD5c2fstring(name, c_name, name_cp_sz, name_cp_sz+1_SIZE_T)

!c_size = H5Eget_class_name(class_id, c_name, name_cp_sz+2)
PRINT*,c_name
! CALL HD5c2fstring(name, c_name, name_cp_sz, name_cp_sz+1_SIZE_T)
! name = "Custom error class"
! PRINT*,name
DEALLOCATE(c_name)

IF(PRESENT(size))THEN
Expand Down Expand Up @@ -786,5 +789,147 @@ END FUNCTION H5Eappend_stack

END SUBROUTINE H5Eappend_stack_f

!>
!! \ingroup FH5E
!!
!! \brief Returns a copy of the current error stack.
!!
!! \param err_stack_id Error stack identifier
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eget_current_stack()
!!
SUBROUTINE H5Eget_current_stack_f(err_stack_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(OUT) :: err_stack_id
INTEGER , INTENT(OUT) :: hdferr

INTERFACE
INTEGER(HID_T) FUNCTION H5Eget_current_stack() BIND(C, NAME='H5Eget_current_stack')
IMPORT :: HID_T
IMPLICIT NONE
END FUNCTION H5Eget_current_stack
END INTERFACE

err_stack_id = H5Eget_current_stack()

hdferr = 0
IF(err_stack_id.LT.0) hdferr = -1

END SUBROUTINE H5Eget_current_stack_f

!>
!! \ingroup FH5E
!!
!! \brief Replaces the current error stack.
!!
!! \param err_stack_id Error stack identifier
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eset_current_stack()
!!
SUBROUTINE H5Eset_current_stack_f(err_stack_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN ) :: err_stack_id
INTEGER , INTENT(OUT) :: hdferr

INTERFACE
INTEGER(C_INT) FUNCTION H5Eset_current_stack(err_stack_id) BIND(C, NAME='H5Eset_current_stack')
IMPORT :: C_INT, HID_T
IMPLICIT NONE
INTEGER(HID_T), VALUE :: err_stack_id
END FUNCTION H5Eset_current_stack
END INTERFACE

hdferr = INT(H5Eset_current_stack(err_stack_id))

END SUBROUTINE H5Eset_current_stack_f

!>
!! \ingroup FH5E
!!
!! \brief Closes an error stack handle.
!!
!! \param err_stack_id Error stack identifier
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eclose_stack()
!!
SUBROUTINE H5Eclose_stack_f(err_stack_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN ) :: err_stack_id
INTEGER , INTENT(OUT) :: hdferr

INTERFACE
INTEGER(C_INT) FUNCTION H5Eclose_stack(err_stack_id) BIND(C, NAME='H5Eclose_stack')
IMPORT :: C_INT, HID_T
IMPLICIT NONE
INTEGER(HID_T), VALUE :: err_stack_id
END FUNCTION H5Eclose_stack
END INTERFACE

hdferr = INT(H5Eclose_stack(err_stack_id))

END SUBROUTINE H5Eclose_stack_f

!>
!! \ingroup FH5E
!!
!! \brief Creates a new, empty error stack.
!!
!! \param err_stack_id Error stack identifier
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Ecreate_stack()
!!
SUBROUTINE H5Ecreate_stack_f(err_stack_id, hdferr)
IMPLICIT NONE
INTEGER(HID_T), INTENT(OUT) :: err_stack_id
INTEGER , INTENT(OUT) :: hdferr

INTERFACE
INTEGER(HID_T) FUNCTION H5Ecreate_stack() BIND(C, NAME='H5Ecreate_stack')
IMPORT :: HID_T
IMPLICIT NONE
END FUNCTION H5Ecreate_stack
END INTERFACE

err_stack_id = H5Ecreate_stack()

hdferr = 0
IF(err_stack_id.LT.0) hdferr = -1

END SUBROUTINE H5Ecreate_stack_f

!>
!! \ingroup FH5E
!!
!! \brief Deletes specified number of error messages from the error stack.
!!
!! \param err_stack_id Error stack identifier
!! \param count The number of error messages to be deleted from the top of error stack
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Epop()
!!
SUBROUTINE H5Epop_f(err_stack_id, count, hdferr)
IMPLICIT NONE
INTEGER(HID_T) , INTENT(IN ) :: err_stack_id
INTEGER(SIZE_T), INTENT(IN ) :: count
INTEGER , INTENT(OUT) :: hdferr

INTERFACE
INTEGER(C_INT) FUNCTION H5Epop(err_stack_id, count) BIND(C, NAME='H5Epop')
IMPORT :: C_INT, HID_T, SIZE_T
IMPLICIT NONE
INTEGER(HID_T) , VALUE :: err_stack_id
INTEGER(SIZE_T), VALUE :: count
END FUNCTION H5Epop
END INTERFACE

hdferr = INT(H5Epop(err_stack_id, count))

END SUBROUTINE H5Epop_f

END MODULE H5E

5 changes: 5 additions & 0 deletions fortran/src/hdf5_fortrandll.def.in
View file
Original file line number Diff line number Diff line change
Expand Up @@ -120,6 +120,11 @@ H5E_mp_H5EGET_NUM_F
H5E_mp_H5EWALK_F
H5E_mp_H5EGET_CLASS_NAME_F
H5E_mp_H5EAPPEND_STACK_F
H5E_mp_H5EGET_CURRENT_STACK_F
H5E_mp_H5ESET_CURRENT_STACK_F
H5E_mp_H5ECREATE_STACK_F
H5E_mp_H5ECLOSE_STACK_F
H5E_mp_H5EPOP_F
; H5ES
H5ES_mp_H5ESCREATE_F
H5ES_mp_H5ESGET_COUNT_F
Expand Down
26 changes: 25 additions & 1 deletion fortran/test/tH5E_F03.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -308,7 +308,7 @@ SUBROUTINE test_error_stack(total_error)

INTEGER :: total_error
INTEGER :: error
INTEGER(HID_T) :: cls_id, major, minor
INTEGER(HID_T) :: cls_id, major, minor, estack_id1, estack_id2
CHARACTER(LEN=18), TARGET :: file
CHARACTER(LEN=18), TARGET :: func
INTEGER , TARGET :: line
Expand Down Expand Up @@ -427,6 +427,7 @@ SUBROUTINE test_error_stack(total_error)
CALL h5eprint_f(error, "H5Etest.txt")
CALL check("h5eprint_f", error, total_error)


INQUIRE(file="H5Etest.txt", EXIST=status)
IF(.NOT.status)THEN
CALL check("h5eprint_f", -1, total_error)
Expand Down Expand Up @@ -467,17 +468,40 @@ SUBROUTINE test_error_stack(total_error)
stderr = "** Print error stack in customized way **"//C_NULL_CHAR
ptr4 = C_LOC(stderr(1:1))
func_ptr = C_FUNLOC(custom_print_cb)

! MSB WHY DOES THIS RESET count to 0? FIX
#if 1
CALL h5ewalk_f(H5P_DEFAULT_F, H5E_WALK_UPWARD_F, func_ptr, ptr4, error)
CALL check("h5ewalk_f", error, total_error)

CALL h5eget_num_f(H5P_DEFAULT_F, count, error)
PRINT*,"LJDF2332", count
#endif

! Copy error stack, which clears the original
CALL H5Eget_current_stack_f(estack_id1, error)
CALL check("H5Eget_current_stack_f", error, total_error)

CALL h5eget_num_f(estack_id1, count, error)
CALL check("h5eget_num_f", error, total_error)
CALL VERIFY("h5eget_num_f", count, 1_SIZE_T, total_error)

CALL H5Eclose_msg_f(major, error)
CALL check("H5Eclose_msg_f", error, total_error)

CALL H5Eclose_msg_f(minor, error)
CALL check("H5Eclose_msg_f", error, total_error)

CALL h5eunregister_class_f(cls_id, error)
CALL check("H5Eunregister_class_f", error, total_error)

CALL H5Ecreate_stack_f(estack_id2, error)
CALL check("H5Ecreate_stack_f", error, total_error)

CALL H5Eclose_stack_f(estack_id2, error)
CALL check(" H5Eclose_stack_f", error, total_error)


END SUBROUTINE test_error_stack

END MODULE TH5E_F03

0 comments on commit 3861b97

Please sign in to comment.