Skip to content

Commit

Permalink
misc2
Browse files Browse the repository at this point in the history
  • Loading branch information
@brtnfld
brtnfld committed Feb 17, 2024
1 parent 92bc43c commit 5705b33
Show file tree
Hide file tree
Showing 2 changed files with 38 additions and 122 deletions.
124 changes: 17 additions & 107 deletions fortran/src/H5Eff.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -126,6 +126,7 @@ END FUNCTION h5eprint_c2
hdferr = h5eprint_c2()
ENDIF
END SUBROUTINE h5eprint_f

!>
!! \ingroup FH5E
!!
Expand All @@ -141,22 +142,18 @@ END SUBROUTINE h5eprint_f
!! See C API: @ref H5Eget_major()
!!
SUBROUTINE h5eget_major_f(error_no, name, namelen, hdferr)
INTEGER, INTENT(IN) :: error_no
CHARACTER(LEN=*), INTENT(OUT) :: name
INTEGER(SIZE_T), INTENT(IN) :: namelen
INTEGER(HID_T) , INTENT(IN) :: error_no
CHARACTER(LEN=*), INTENT(OUT) :: name
INTEGER(SIZE_T) , INTENT(INOUT) :: namelen
INTEGER, INTENT(OUT) :: hdferr
INTERFACE
INTEGER FUNCTION h5eget_major_c(error_no, name, namelen) BIND(C,NAME='h5eget_major_c')
IMPORT :: C_CHAR
IMPORT :: SIZE_T
IMPLICIT NONE
INTEGER :: error_no
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name
INTEGER(SIZE_T) :: namelen
END FUNCTION h5eget_major_c
END INTERFACE

hdferr = h5eget_major_c(error_no, name, namelen)
INTEGER :: msg_type
INTEGER(SIZE_T) :: namelen2

namelen2 = namelen

CALL H5Eget_msg_f(error_no, msg_type, name, hdferr, namelen2)

END SUBROUTINE h5eget_major_f
!>
!! \ingroup FH5E
Expand All @@ -172,22 +169,13 @@ END SUBROUTINE h5eget_major_f
!! See C API: @ref H5Eget_minor()
!!
SUBROUTINE h5eget_minor_f(error_no, name, hdferr)
INTEGER, INTENT(IN) :: error_no
INTEGER(HID_T) , INTENT(IN) :: error_no
CHARACTER(LEN=*), INTENT(OUT) :: name
INTEGER, INTENT(OUT) :: hdferr

INTEGER(SIZE_T) :: namelen
INTERFACE
INTEGER FUNCTION h5eget_minor_c(error_no, name, namelen) BIND(C,NAME='h5eget_minor_c')
IMPORT :: C_CHAR, SIZE_T
INTEGER :: error_no
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name
INTEGER(SIZE_T) :: namelen
END FUNCTION h5eget_minor_c
END INTERFACE
INTEGER :: msg_type

namelen = LEN(name)
hdferr = h5eget_minor_c(error_no, name, namelen)
CALL H5Eget_msg_f(error_no, msg_type, name, hdferr)

END SUBROUTINE h5eget_minor_f
!>
Expand Down Expand Up @@ -619,9 +607,9 @@ END SUBROUTINE H5Eget_msg_f
!!
!! \brief Retrieves the number of error messages in an error stack.
!!
!! \param err_id An error message identifier
!! \param count Number of error messages in \p err_id
!! \param hdferr \fortran_error
!! \param error_stack_id An error message identifier
!! \param count Number of error messages in \p err_id
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eget_num()
!!
Expand Down Expand Up @@ -762,83 +750,5 @@ END FUNCTION H5Eget_class_name

END SUBROUTINE H5Eget_class_name_f


#if 0
!>
!! \ingroup FH5E
!!
!! \brief Returns a character string describing an error specified by a major error number.
!!
!! \param error_no Major error number.
!! \param name Character string describing the error.
!! \param namelen Number of characters in the name buffer.
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eget_major()
!!
SUBROUTINE h5eget_major_f(error_no, name, namelen, hdferr)
INTEGER, INTENT(IN) :: error_no
CHARACTER(LEN=*), INTENT(OUT) :: name
INTEGER(SIZE_T), INTENT(IN) :: namelen
INTEGER, INTENT(OUT) :: hdferr
INTERFACE
INTEGER FUNCTION h5eget_major_c(error_no, name, namelen) BIND(C,NAME='h5eget_major_c')
IMPORT :: C_CHAR
IMPORT :: SIZE_T
IMPLICIT NONE
INTEGER :: error_no
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name
INTEGER(SIZE_T) :: namelen
END FUNCTION h5eget_major_c
END INTERFACE

hdferr = h5eget_major_c(error_no, name, namelen)
END SUBROUTINE h5eget_major_f
!>
!! \ingroup FH5E
!!
!! \brief Returns a character string describing an error specified by a minor error number.
!!
!! \param error_no Minor error number.
!! \param name Character string describing the error.
!! \param hdferr \fortran_error
!!
!! See C API: @ref H5Eget_minor()
!!
SUBROUTINE h5eget_minor_f(error_no, name, hdferr)
INTEGER , INTENT(IN) :: error_no
CHARACTER(LEN=*), INTENT(OUT) :: name
INTEGER , INTENT(OUT) :: hdferr

CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(1:LEN(name)+1), TARGET :: c_name
TYPE(C_PTR) :: f_ptr
!CHARACTER(LEN=LEN(name), kind=c_char), POINTER ::

INTERFACE
FUNCTION H5Eget_minor(error_no) RESULT(name) BIND(C,NAME='H5Eget_minor')
IMPORT :: C_PTR, C_INT
INTEGER(C_INT), VALUE :: error_no
TYPE(C_PTR) :: name
END FUNCTION H5Eget_minor
END INTERFACE

f_ptr = C_LOC(c_name(1:1)(1:1))
f_ptr = H5Eget_minor( INT(error_no, C_INT) )

hdferr = 0
IF( .not. c_associated(f_ptr))THEN
hdferr = -1
PRINT*, "NOT"
ELSE
PRINT*, "YES", c_name(1)
! CALL C_F_POINTER(c_name(1), data)
! f_ptr = C_LOC(c_name(1:1)(1:1)

CALL HD5c2fstring(name, c_name, LEN(name))
ENDIF

END SUBROUTINE h5eget_minor_f
#endif

END MODULE H5E

36 changes: 21 additions & 15 deletions fortran/test/tH5E_F03.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,7 +110,7 @@ INTEGER(C_INT) FUNCTION custom_print_cb(n, err_desc, op_data) BIND(C)
TYPE(C_PTR) :: op_data

CHARACTER(LEN=MSG_SIZE) :: maj
CHARACTER(LEN=MSG_SIZE) :: min
CHARACTER(LEN=MSG_SIZE) :: minn
CHARACTER(LEN=MSG_SIZE) :: cls
INTEGER :: indent = 4
INTEGER(SIZE_T) :: size
Expand Down Expand Up @@ -160,33 +160,39 @@ INTEGER(C_INT) FUNCTION custom_print_cb(n, err_desc, op_data) BIND(C)
RETURN
ENDIF

! CALL h5eget_major_f(INT(err_desc%maj_num), maj, size, error)
CALL h5eget_major_f(err_desc%maj_num, maj, size, error)
IF("MAJOR MSG".NE.TRIM(maj))THEN
custom_print_cb = -1
RETURN
ENDIF

IF(error .LT. 0)THEN
custom_print_cb = -1
RETURN
ENDIF

CALL h5eget_minor_f(err_desc%min_num, minn, error)
IF(error .LT. 0)THEN
custom_print_cb = -1
RETURN
ENDIF
IF("MIN MSG".NE.TRIM(minn))THEN
custom_print_cb = -1
RETURN
ENDIF

custom_print_cb = 0

END FUNCTION custom_print_cb
#if 0
FILE *stream = (FILE *)client_data;


if (H5Eget_msg(err_desc->maj_num, NULL, maj, MSG_SIZE) < 0)
TEST_ERROR;

if (H5Eget_msg(err_desc->min_num, NULL, min, MSG_SIZE) < 0)
TEST_ERROR;

fprintf(stream, "%*serror #%03d: %s in %s(): line %u\n", indent, "", n, err_desc->file_name,
err_desc->func_name, err_desc->line);
fprintf(stream, "%*sclass: %s\n", indent * 2, "", cls);
fprintf(stream, "%*smajor: %s\n", indent * 2, "", maj);
fprintf(stream, "%*sminor: %s\n", indent * 2, "", min);

return 0;

error:
return -1;
} /* end custom_print_cb() */

#endif

END MODULE test_my_hdf5_error_handler
Expand Down

0 comments on commit 5705b33

Please sign in to comment.