diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index 449c8fa1b27..316c9ad9a5d 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -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); diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 9ea28079451..162a7508085 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -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(). @@ -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, & @@ -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, & @@ -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)) @@ -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 !! @@ -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) diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 4bc8c2fa21d..0da371f5e17 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -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 diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 33d666c1b47..b538e20c530 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -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 @@ -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 @@ -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 @@ -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" @@ -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) @@ -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) @@ -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