Skip to content

Commit

Permalink
Reworked H5Epush_f (HDFGroup#4153)
Browse files Browse the repository at this point in the history
  • Loading branch information
@brtnfld @lrknox
brtnfld authored and lrknox committed Mar 21, 2024
1 parent 84b6dfa commit 1818212
Show file tree
Hide file tree
Showing 4 changed files with 93 additions and 91 deletions.
23 changes: 14 additions & 9 deletions fortran/src/H5Ef.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -99,26 +99,31 @@ h5eset_auto2_c(int_f *printflag, hid_t_f *estack_id, H5E_auto2_t func, void *cli
}

int_f
h5epush_c(hid_t_f *err_stack, hid_t_f *cls_id, hid_t_f *maj_id, hid_t_f *min_id, _fcd msg, size_t_f *msg_len,
char *file, char *func, int *line, const char *arg1, const char *arg2, const char *arg3,
const char *arg4, const char *arg5, const char *arg6, const char *arg7, const char *arg8,
const char *arg9, const char *arg10, const char *arg11, const char *arg12, const char *arg13,
const char *arg14, const char *arg15, const char *arg16, const char *arg17, const char *arg18,
const char *arg19, const char *arg20)
h5epush_c(hid_t_f *err_stack, _fcd file, int_f *file_len, _fcd func, int_f *func_len, int line,
hid_t_f *cls_id, hid_t_f *maj_id, hid_t_f *min_id, _fcd msg, int_f *msg_len, const char *arg1,
const char *arg2, const char *arg3, const char *arg4, const char *arg5, const char *arg6,
const char *arg7, const char *arg8, const char *arg9, const char *arg10, const char *arg11,
const char *arg12, const char *arg13, const char *arg14, const char *arg15, const char *arg16,
const char *arg17, const char *arg18, const char *arg19, const char *arg20)
/******/
{

char *c_file = NULL; /* Buffer to hold C string */
char *c_func = NULL; /* Buffer to hold C string */
char *c_msg = NULL; /* Buffer to hold C string */
int_f ret_value = 0; /* Return value */

/*
* Convert FORTRAN name to C name
* Convert FORTRAN string to C string
*/

if (NULL == (c_file = HD5f2cstring(file, (size_t)*file_len)))
HGOTO_DONE(FAIL);
if (NULL == (c_func = HD5f2cstring(func, (size_t)*func_len)))
HGOTO_DONE(FAIL);
if (NULL == (c_msg = HD5f2cstring(msg, (size_t)*msg_len)))
HGOTO_DONE(FAIL);

if (H5Epush2((hid_t)*err_stack, file, func, (unsigned int)*line, (hid_t)*cls_id, (hid_t)*maj_id,
if (H5Epush2((hid_t)*err_stack, c_file, c_func, (unsigned int)line, (hid_t)*cls_id, (hid_t)*maj_id,
(hid_t)*min_id, c_msg, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11,
arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20) < 0)
HGOTO_DONE(FAIL);
Expand Down
104 changes: 50 additions & 54 deletions fortran/src/H5Eff.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -277,34 +277,34 @@ END SUBROUTINE h5eset_auto_f
!!
!! \param err_stack Error stack identifier. If the identifier is H5E_DEFAULT_F, the error
!! record will be pushed to the current stack.
!! \param file Name of the file in which the error was detected
!! \param func Name of the function in which the error was detected
!! \param line Line number in the file where the error was detected
!! \param cls_id Error class identifier
!! \param maj_id Major error identifier
!! \param min_id Minor error identifier
!! \param msg Error description string
!! \param msg Error description string
!! \param hdferr \fortran_error
!! \param file Name of the file in which the error was detected
!! \param func Name of the function in which the error was detected
!! \param line Line number in the file where the error was detected
!! \param arg1 C style format control strings
!! \param arg2 C style format control strings
!! \param arg3 C style format control strings
!! \param arg4 C style format control strings
!! \param arg5 C style format control strings
!! \param arg6 C style format control strings
!! \param arg7 C style format control strings
!! \param arg8 C style format control strings
!! \param arg9 C style format control strings
!! \param arg10 C style format control strings
!! \param arg11 C style format control strings
!! \param arg12 C style format control strings
!! \param arg13 C style format control strings
!! \param arg14 C style format control strings
!! \param arg15 C style format control strings
!! \param arg16 C style format control strings
!! \param arg17 C style format control strings
!! \param arg18 C style format control strings
!! \param arg19 C style format control strings
!! \param arg20 C style format control strings
!! \param arg1 C style format control strings
!! \param arg2 C style format control strings
!! \param arg3 C style format control strings
!! \param arg4 C style format control strings
!! \param arg5 C style format control strings
!! \param arg6 C style format control strings
!! \param arg7 C style format control strings
!! \param arg8 C style format control strings
!! \param arg9 C style format control strings
!! \param arg10 C style format control strings
!! \param arg11 C style format control strings
!! \param arg12 C style format control strings
!! \param arg13 C style format control strings
!! \param arg14 C style format control strings
!! \param arg15 C style format control strings
!! \param arg16 C style format control strings
!! \param arg17 C style format control strings
!! \param arg18 C style format control strings
!! \param arg19 C style format control strings
!! \param arg20 C style format control strings
!!
!! \note \p arg[1-20] expects C-style format strings, similar to the
!! system and C functions printf() and fprintf().
Expand All @@ -322,28 +322,24 @@ END SUBROUTINE h5eset_auto_f
!!
!! See C API: @ref H5Epush2()
!!
SUBROUTINE h5epush_f(err_stack, cls_id, maj_id, min_id, msg, hdferr, &
file, func, line, &
SUBROUTINE h5epush_f(err_stack, file, func, line, cls_id, maj_id, min_id, msg, hdferr, &
arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, &
arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20)
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN) :: err_stack
INTEGER(HID_T), INTENT(IN) :: cls_id
INTEGER(HID_T), INTENT(IN) :: maj_id
INTEGER(HID_T), INTENT(IN) :: min_id
CHARACTER(LEN=*), INTENT(IN) :: msg
INTEGER, INTENT(OUT) :: hdferr
INTEGER(HID_T) , INTENT(IN) :: err_stack
CHARACTER(LEN=*), INTENT(IN) :: file
CHARACTER(LEN=*), INTENT(IN) :: func
INTEGER , INTENT(IN) :: line
INTEGER(HID_T) , INTENT(IN) :: cls_id
INTEGER(HID_T) , INTENT(IN) :: maj_id
INTEGER(HID_T) , INTENT(IN) :: min_id
CHARACTER(LEN=*), INTENT(IN) :: msg
INTEGER , INTENT(OUT) :: hdferr

TYPE(C_PTR), OPTIONAL :: file
TYPE(C_PTR), OPTIONAL :: func
TYPE(C_PTR), OPTIONAL :: line
CHARACTER(LEN=*), OPTIONAL, TARGET :: arg1, arg2, arg3, arg4, arg5, &
arg6, arg7, arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, &
arg16, arg17, arg18, arg19, arg20

TYPE(C_PTR) :: file_def = C_NULL_PTR
TYPE(C_PTR) :: func_def = C_NULL_PTR
TYPE(C_PTR) :: line_def = C_NULL_PTR
TYPE(C_PTR) :: arg1_def = C_NULL_PTR, arg2_def = C_NULL_PTR, &
arg3_def = C_NULL_PTR, arg4_def = C_NULL_PTR, &
arg5_def = C_NULL_PTR, arg6_def = C_NULL_PTR, &
Expand All @@ -356,7 +352,9 @@ SUBROUTINE h5epush_f(err_stack, cls_id, maj_id, min_id, msg, hdferr, &
arg19_def = C_NULL_PTR, arg20_def = C_NULL_PTR

INTERFACE
INTEGER FUNCTION h5epush_c(err_stack, cls_id, maj_id, min_id, msg, msg_len, file, func, line, &
INTEGER FUNCTION h5epush_c(err_stack, &
file, file_len, func, func_len, line, &
cls_id, maj_id, min_id, msg, msg_len, &
arg1, arg2, arg3, arg4, arg5, &
arg6, arg7, arg8, arg9, arg10, &
arg11, arg12, arg13, arg14, arg15, &
Expand All @@ -366,28 +364,25 @@ INTEGER FUNCTION h5epush_c(err_stack, cls_id, maj_id, min_id, msg, msg_len, file
IMPORT :: HID_T
IMPLICIT NONE
INTEGER(HID_T) :: err_stack
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: file
INTEGER :: file_len
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: func
INTEGER :: func_len
INTEGER(C_INT), VALUE :: line
INTEGER(HID_T) :: cls_id
INTEGER(HID_T) :: maj_id
INTEGER(HID_T) :: min_id
CHARACTER(KIND=C_CHAR), DIMENSION(*) :: msg
INTEGER :: msg_len

TYPE(C_PTR), VALUE :: file
TYPE(C_PTR), VALUE :: func
TYPE(C_PTR), VALUE :: line
TYPE(C_PTR), VALUE :: arg1, arg2, arg3, arg4, &
arg5, arg6, arg7, arg8, &
arg9, arg10, arg11, arg12, &
arg13, arg14, arg15, arg16, &
arg17, arg18, arg19, arg20
TYPE(C_PTR), VALUE :: arg1, arg2, arg3, arg4, arg5, &
arg6, arg7, arg8, arg9, arg10, &
arg11, arg12, arg13, arg14, arg15, &
arg16, arg17, arg18, arg19, arg20

END FUNCTION h5epush_c
END INTERFACE

IF (PRESENT(file)) file_def = file
IF (PRESENT(func)) func_def = func
IF (PRESENT(line)) line_def = line

IF (PRESENT(arg1)) arg1_def = C_LOC(arg1(1:1))
IF (PRESENT(arg2)) arg2_def = C_LOC(arg2(1:1))
IF (PRESENT(arg3)) arg3_def = C_LOC(arg3(1:1))
Expand All @@ -409,14 +404,15 @@ END FUNCTION h5epush_c
IF (PRESENT(arg19)) arg19_def = C_LOC(arg19(1:1))
IF (PRESENT(arg20)) arg20_def = C_LOC(arg20(1:1))

hdferr = h5epush_c(err_stack, cls_id, maj_id, min_id, msg, LEN(msg), &
file_def, func_def, line_def, &
hdferr = h5epush_c(err_stack, file, LEN(file), func, LEN(func), INT(line,C_INT), &
cls_id, maj_id, min_id, msg, LEN(msg), &
arg1_def, arg2_def, arg3_def, arg4_def, arg5_def, &
arg6_def, arg7_def, arg8_def, arg9_def, arg10_def, &
arg11_def, arg12_def, arg13_def, arg14_def, arg15_def, &
arg16_def, arg17_def, arg18_def, arg19_def, arg20_def)

END SUBROUTINE h5epush_f

!>
!! \ingroup FH5E
!!
Expand Down Expand Up @@ -631,7 +627,7 @@ END FUNCTION H5Eget_msg
RETURN
ENDIF
f_ptr = C_LOC(c_msg(1)(1:1))
c_msg_size = H5Eget_msg(msg_id, c_msg_type, f_ptr, msg_cp_sz+1)
c_msg_size = H5Eget_msg(msg_id, c_msg_type, f_ptr, msg_cp_sz+1_SIZE_T)

CALL HD5c2fstring(msg, c_msg, msg_cp_sz, msg_cp_sz+1_SIZE_T)

Expand Down
14 changes: 7 additions & 7 deletions fortran/src/H5f90proto.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -555,13 +555,13 @@ H5_FCDLL int_f h5iis_valid_c(hid_t_f *obj_id, int_f *c_valid);

H5_FCDLL int_f h5eprint_c(hid_t_f *err_stack, _fcd name, size_t_f *namelen);
H5_FCDLL int_f h5eset_auto2_c(int_f *printflag, hid_t_f *estack_id, H5E_auto2_t func, void *client_data);
H5_FCDLL int_f h5epush_c(hid_t_f *err_stack, hid_t_f *cls_id, hid_t_f *maj_id, hid_t_f *min_id, _fcd msg,
size_t_f *msg_len, char *file, char *func, int *line, const char *arg1,
const char *arg2, const char *arg3, const char *arg4, const char *arg5,
const char *arg6, const char *arg7, const char *arg8, const char *arg9,
const char *arg10, const char *arg11, const char *arg12, const char *arg13,
const char *arg14, const char *arg15, const char *arg16, const char *arg17,
const char *arg18, const char *arg19, const char *arg20);
H5_FCDLL int_f h5epush_c(hid_t_f *err_stack, _fcd file, int_f *file_len, _fcd func, int_f *func_len, int line,
hid_t_f *cls_id, hid_t_f *maj_id, hid_t_f *min_id, _fcd msg, int_f *msg_len,
const char *arg1, const char *arg2, const char *arg3, const char *arg4,
const char *arg5, const char *arg6, const char *arg7, const char *arg8,
const char *arg9, const char *arg10, const char *arg11, const char *arg12,
const char *arg13, const char *arg14, const char *arg15, const char *arg16,
const char *arg17, const char *arg18, const char *arg19, const char *arg20);

/*
* Functions from H5f.c
Expand Down
43 changes: 22 additions & 21 deletions fortran/test/tH5E_F03.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,14 +47,14 @@ MODULE test_my_hdf5_error_handler
!**
!***************************************************************

INTEGER FUNCTION my_hdf5_error_handler(estack_id, data_inout) bind(C)
INTEGER(C_INT) FUNCTION my_hdf5_error_handler(estack_id, data_inout) bind(C)

! This error function handle works with only version 2 error stack

IMPLICIT NONE

! estack_id is always passed from C as: H5E_DEFAULT
INTEGER(HID_T) :: estack_id
INTEGER(HID_T), VALUE :: estack_id

! data that was registered with H5Eset_auto_f
! INTEGER :: data_inout ! another option
Expand Down Expand Up @@ -89,7 +89,7 @@ INTEGER(C_INT) FUNCTION custom_print_cb(n, err_desc, op_data) BIND(C)

INTEGER(SIZE_T), PARAMETER :: MSG_SIZE = 64

INTEGER(C_INT) :: n
INTEGER(C_INT), VALUE :: n
TYPE(h5e_error_t) :: err_desc
TYPE(C_PTR) :: op_data

Expand All @@ -101,6 +101,11 @@ INTEGER(C_INT) FUNCTION custom_print_cb(n, err_desc, op_data) BIND(C)

INTEGER :: error

IF(n.NE.0_C_INT)THEN
custom_print_cb = -1
RETURN
ENDIF

CALL H5Eget_class_name_f(err_desc%cls_id, cls, error)
IF(error .LT.0)THEN
custom_print_cb = -1
Expand Down Expand Up @@ -252,10 +257,10 @@ SUBROUTINE test_error_stack(total_error)
INTEGER :: total_error
INTEGER :: error
INTEGER(HID_T) :: cls_id, major, minor, estack_id, estack_id1, estack_id2
CHARACTER(LEN=18), TARGET :: file
CHARACTER(LEN=18), TARGET :: func
INTEGER(C_INT) , TARGET :: line
TYPE(C_PTR) :: ptr1, ptr2, ptr3, ptr4
CHARACTER(LEN=18) :: file
CHARACTER(LEN=18) :: func
INTEGER :: line
TYPE(C_PTR) :: ptr1

INTEGER :: msg_type
CHARACTER(LEN=9) :: maj_mesg = "MAJOR MSG"
Expand Down Expand Up @@ -283,21 +288,17 @@ SUBROUTINE test_error_stack(total_error)
CALL H5Ecreate_msg_f(cls_id, H5E_MINOR_F, min_mesg, minor, error)
CALL check("H5Ecreate_msg_f", error, total_error)

file = "FILE"//C_NULL_CHAR
func = "FUNC"//C_NULL_CHAR
file = "FILE"
func = "FUNC"
line = 99

ptr1 = C_LOC(file(1:1))
ptr2 = C_LOC(func(1:1))
ptr3 = C_LOC(line)

CALL h5ecreate_stack_f(estack_id, error)
CALL check("h5ecreate_stack_f", error, total_error)

! push a custom error message onto the stack
CALL H5Epush_f(estack_id, cls_id, major, minor, "%s ERROR TEXT %s %s", error, &
ptr1, ptr2, ptr3, &
arg1=ACHAR(27)//"[31m", arg2=ACHAR(27)//"[0m", arg3=ACHAR(10) )
CALL H5Epush_f(estack_id, file, func, line, &
cls_id, major, minor, "%s ERROR TEXT %s %s %s", error, &
arg1=ACHAR(27)//"[31m", arg2=ACHAR(27)//"[0m", arg3=ACHAR(0), arg4=ACHAR(10) )
CALL check("H5Epush_f", error, total_error)

CALL h5eget_num_f(estack_id, count, error)
Expand Down Expand Up @@ -421,10 +422,10 @@ SUBROUTINE test_error_stack(total_error)
ENDIF

stderr = "** Print error stack in customized way **"//C_NULL_CHAR
ptr4 = C_LOC(stderr(1:1))
ptr1 = C_LOC(stderr(1:1))
func_ptr = C_FUNLOC(custom_print_cb)

CALL h5ewalk_f(estack_id, H5E_WALK_UPWARD_F, func_ptr, ptr4, error)
CALL h5ewalk_f(estack_id, H5E_WALK_UPWARD_F, func_ptr, ptr1, error)
CALL check("h5ewalk_f", error, total_error)

CALL h5eget_num_f(estack_id, count, error)
Expand Down Expand Up @@ -462,9 +463,9 @@ SUBROUTINE test_error_stack(total_error)
CALL check("h5ecreate_stack_f", error, total_error)

! push a custom error message onto the stack
CALL H5Epush_f(estack_id1, cls_id, major, minor, "%s ERROR TEXT %s"//C_NEW_LINE, error, &
ptr1, ptr2, ptr3, &
arg1=ACHAR(27)//"[31m", arg2=ACHAR(27)//"[0m" )
CALL H5Epush_f(estack_id1, file, func, line, &
cls_id, major, minor, "%s ERROR TEXT %s %s", error, &
arg1=ACHAR(27)//"[31m", arg2=ACHAR(27)//"[0m", arg3=ACHAR(10) )
CALL check("H5Epush_f", error, total_error)

CALL H5Eset_current_stack_f(estack_id1, error) ! API will also close estack_id1
Expand Down

0 comments on commit 1818212

Please sign in to comment.