diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index b0faca645c6..b086357d2eb 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -254,7 +254,7 @@ 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, char *arg1, char *arg2, char *arg3, char *arg4, char *arg5, + char *file, char *func, int *line, const char *arg1, const char *arg2, char *arg3, char *arg4, char *arg5, char *arg6, char *arg7, char *arg8, char *arg9, char *arg10, char *arg11, char *arg12, char *arg13, char *arg14, char *arg15, char *arg16, char *arg17, char *arg18, char *arg19, char *arg20) /******/ @@ -262,9 +262,11 @@ h5epush_c(hid_t_f *err_stack, hid_t_f *cls_id, hid_t_f *maj_id, hid_t_f *min_id, char *c_msg = NULL; /* Buffer to hold C string */ int_f ret_value = 0; /* Return value */ + /* * Convert FORTRAN name to C name */ + if (NULL == (c_msg = HD5f2cstring(msg, (size_t)*msg_len))) HGOTO_DONE(FAIL); diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 82119bd4bcd..2f1d2bcd0b0 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -136,7 +136,7 @@ INTEGER FUNCTION h5eget_major_c(error_no, name, namelen) BIND(C,NAME='h5eget_ma IMPLICIT NONE INTEGER :: error_no CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name - INTEGER(SIZE_T), INTENT(IN) :: namelen + INTEGER(SIZE_T) :: namelen END FUNCTION h5eget_major_c END INTERFACE @@ -157,15 +157,20 @@ SUBROUTINE h5eget_minor_f(error_no, name, hdferr) INTEGER, 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) BIND(C,NAME='h5eget_minor_c') - IMPORT :: C_CHAR + 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(*), INTENT(OUT) :: name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name + INTEGER(SIZE_T) :: namelen END FUNCTION h5eget_minor_c END INTERFACE - hdferr = h5eget_minor_c(error_no, name) + namelen = LEN(name) + hdferr = h5eget_minor_c(error_no, name, namelen) + END SUBROUTINE h5eget_minor_f !> !! \ingroup FH5E @@ -215,7 +220,8 @@ END FUNCTION h5eset_auto2_c hdferr = h5eset_auto2_c(printflag, estack_id_default, func_default, client_data_default) END SUBROUTINE h5eset_auto_f - SUBROUTINE h5epush_f(err_stack, cls_id, maj_id, min_id, msg, hdferr, file, func, line, & + SUBROUTINE h5epush_f(err_stack, cls_id, maj_id, min_id, msg, hdferr, & + file, func, line, & arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, & arg11, arg12, arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20) IMPLICIT NONE @@ -226,16 +232,16 @@ SUBROUTINE h5epush_f(err_stack, cls_id, maj_id, min_id, msg, hdferr, file, func, CHARACTER(LEN=*), INTENT(IN) :: msg INTEGER, INTENT(OUT) :: hdferr - TYPE(C_PTR), OPTIONAL, INTENT(IN), TARGET :: file - TYPE(C_PTR), OPTIONAL, INTENT(IN), TARGET :: func - INTEGER , OPTIONAL, INTENT(IN) :: line - CHARACTER(LEN=*), OPTIONAL, INTENT(IN), TARGET :: arg1, arg2, arg3, arg4, arg5, & + TYPE(C_PTR), OPTIONAL, INTENT(IN) :: file + TYPE(C_PTR), OPTIONAL, INTENT(IN) :: func + TYPE(C_PTR), OPTIONAL, INTENT(IN) :: 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 - INTEGER(KIND=C_INT) :: line_def = 0 + 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, & @@ -248,7 +254,7 @@ SUBROUTINE h5epush_f(err_stack, cls_id, maj_id, min_id, msg, hdferr, file, func, arg19_def = C_NULL_PTR, arg20_def = C_NULL_PTR INTERFACE - INTEGER FUNCTION h5epush_c(err_stack, cls_id, maj_id, min_id, msg, file, func, line, & + INTEGER FUNCTION h5epush_c(err_stack, cls_id, maj_id, min_id, msg, msg_len, file, func, line, & arg1, arg2, arg3, arg4, arg5, & arg6, arg7, arg8, arg9, arg10, & arg11, arg12, arg13, arg14, arg15, & @@ -262,10 +268,11 @@ INTEGER FUNCTION h5epush_c(err_stack, cls_id, maj_id, min_id, msg, file, func, l 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 - INTEGER(C_INT), VALUE :: line + TYPE(C_PTR), VALUE :: line TYPE(C_PTR), VALUE :: arg1, arg2, arg3, arg4, & arg5, arg6, arg7, arg8, & arg9, arg10, arg11, arg12, & @@ -275,9 +282,9 @@ INTEGER FUNCTION h5epush_c(err_stack, cls_id, maj_id, min_id, msg, file, func, l END FUNCTION h5epush_c END INTERFACE - IF (PRESENT(file)) file_def = C_LOC(file) - IF (PRESENT(func)) func_def = C_LOC(func) - IF (PRESENT(line)) line_def = INT(line, C_INT) + 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) IF (PRESENT(arg2)) arg2_def = C_LOC(arg2) @@ -300,12 +307,12 @@ END FUNCTION h5epush_c IF (PRESENT(arg19)) arg19_def = C_LOC(arg19) IF (PRESENT(arg20)) arg20_def = C_LOC(arg20) - hdferr = h5epush_c(err_stack, cls_id, maj_id, min_id, msg, file_def, func_def, line_def, & - 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) - + hdferr = h5epush_c(err_stack, cls_id, maj_id, min_id, msg, LEN(msg), & + file_def, func_def, line_def, & + 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 @@ -361,6 +368,55 @@ END FUNCTION H5Eunregister_class END SUBROUTINE h5eunregister_class_f + SUBROUTINE h5ecreate_msg_f(class_id, msg_type, msg, err_id, hdferr) + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: class_id + INTEGER , INTENT(IN) :: msg_type + CHARACTER(LEN=*), INTENT(IN) :: msg + INTEGER(HID_T) , INTENT(OUT) :: err_id + INTEGER, INTENT(OUT) :: hdferr + + CHARACTER(LEN=LEN_TRIM(msg)+1,KIND=C_CHAR) :: c_msg + + INTERFACE + INTEGER(HID_T) FUNCTION H5Ecreate_msg(class_id, msg_type, msg) & + BIND(C,NAME='H5Ecreate_msg') + IMPORT :: C_CHAR, C_INT + IMPORT :: HID_T + IMPLICIT NONE + INTEGER(HID_T), VALUE :: class_id + INTEGER(C_INT), VALUE :: msg_type + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: msg + END FUNCTION H5Ecreate_msg + END INTERFACE + + c_msg = TRIM(msg)//C_NULL_CHAR + + err_id = H5Ecreate_msg(class_id, INT(msg_type, C_INT), c_msg) + + hdferr = 0 + IF(err_id.LT.0) hdferr = -1 + + END SUBROUTINE h5ecreate_msg_f + + SUBROUTINE h5eclose_msg_f(err_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: err_id + INTEGER, INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5Eclose_msg(err_id) BIND(C, NAME='H5Eclose_msg') + IMPORT :: HID_T, C_INT + IMPLICIT NONE + INTEGER(HID_T), VALUE :: err_id + END FUNCTION H5Eclose_msg + END INTERFACE + + hdferr = INT(H5Eclose_msg(err_id)) + + END SUBROUTINE h5eclose_msg_f + #if 0 !> !! \ingroup FH5E @@ -386,7 +442,7 @@ INTEGER FUNCTION h5eget_major_c(error_no, name, namelen) BIND(C,NAME='h5eget_ma IMPLICIT NONE INTEGER :: error_no CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name - INTEGER(SIZE_T), INTENT(IN) :: namelen + INTEGER(SIZE_T) :: namelen END FUNCTION h5eget_major_c END INTERFACE diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index e21a44c700a..70a15880d05 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -560,7 +560,7 @@ H5_FCDLL int_f h5eget_major_c(int_f *error_no, _fcd name, size_t_f *namelen); H5_FCDLL int_f h5eget_minor_c(int_f *error_no, _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, char *arg1, char *arg2, + size_t_f *msg_len, char *file, char *func, int *line, const char *arg1, const char *arg2, char *arg3, char *arg4, char *arg5, char *arg6, char *arg7, char *arg8, char *arg9, char *arg10, char *arg11, char *arg12, char *arg13, char *arg14, char *arg15, char *arg16, char *arg17, char *arg18, char *arg19, char *arg20); diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index 6d2f452b000..0bee95e8df1 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -112,6 +112,8 @@ H5E_mp_H5EGET_MINOR_F H5E_mp_H5ESET_AUTO_F H5E_mp_H5EREGISTER_CLASS_F H5E_mp_H5EUNREGISTER_CLASS_F +H5E_mp_H5ECREATE_MSG_F +H5E_mp_H5ECLOSE_MSG_F ; H5ES H5ES_mp_H5ESCREATE_F H5ES_mp_H5ESGET_COUNT_F diff --git a/fortran/test/fortranlib_test_F03.F90 b/fortran/test/fortranlib_test_F03.F90 index 85ab74432d0..3527a0be987 100644 --- a/fortran/test/fortranlib_test_F03.F90 +++ b/fortran/test/fortranlib_test_F03.F90 @@ -175,6 +175,10 @@ PROGRAM fortranlibtest_F03 CALL test_obj_info(ret_total_error) CALL write_test_status(ret_total_error, ' Testing object info functions ', total_error) + ret_total_error = 0 + CALL test_error_stack(ret_total_error) + CALL write_test_status(ret_total_error, ' Test error H5E API stack operations', total_error) + ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing VDS ' diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index c2bf74be061..80bc8d1b280 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -197,4 +197,53 @@ SUBROUTINE test_error(total_error) END SUBROUTINE test_error +SUBROUTINE test_error_stack(total_error) + + IMPLICIT NONE + + INTEGER :: total_error + INTEGER :: error + INTEGER(HID_T) :: cls_id, major, minor + CHARACTER(LEN=18), TARGET :: file + CHARACTER(LEN=18), TARGET :: func + INTEGER , TARGET :: line + TYPE(C_PTR) :: ptr1, ptr2, ptr3 + CHARACTER(LEN=180) :: name + + CALL h5eregister_class_f("Custom error class", "H5E_F03", "0.1", cls_id, error) + CALL check("H5Eregister_class_f", error, total_error) + + CALL H5Ecreate_msg_f(cls_id, H5E_MAJOR_F, "Okay, Houston, we've had a problem here", major, error) + CALL check("H5Ecreate_msg_f", error, total_error) + CALL H5Ecreate_msg_f(cls_id, H5E_MINOR_F, "Oops!", minor, error) + CALL check("H5Ecreate_msg_f", error, total_error) + + file = "FILE"//C_NULL_CHAR + func = "FUNC"//C_NULL_CHAR + line = 99 + + ptr1 = C_LOC(file) + ptr2 = C_LOC(func) + ptr3 = C_LOC(line) + + ! push a custom error message onto the default stack + CALL H5Epush_f(H5E_DEFAULT_F, cls_id, major, minor, "%s Hello, error %s"//C_NEW_LINE, error, & + ptr1, ptr2, ptr3, & + arg1=ACHAR(27)//"[31m", arg2=ACHAR(27)//"[0m" ) + + CALL check("H5Epush_f", error, total_error) + + CALL h5eprint_f(error) !, "stderr") + CALL check("h5eprint_f", error, 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) + +END SUBROUTINE test_error_stack + END MODULE TH5E_F03 diff --git a/src/H5Epublic.h b/src/H5Epublic.h index d68ac3d65d7..12713c0cc3d 100644 --- a/src/H5Epublic.h +++ b/src/H5Epublic.h @@ -255,7 +255,7 @@ H5_DLL herr_t H5Eclose_msg(hid_t err_id); * \param[in] cls An error class identifier * \param[in] msg_type The type of the error message * \param[in] msg Major error message - * \return \herr_t + * \return An error ID (success), H5I_INVALID_HID (failure) * * \details H5Ecreate_msg() adds an error message to an error class defined by * client library or application program. The error message can be