From 2382f4e1161b7e12ba685ca5321be92bf2b2f54b Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Thu, 8 Feb 2024 18:41:55 -0600 Subject: [PATCH 01/31] new fortran H5E APIs --- doxygen/examples/H5E_examples.c | 5 +- fortran/src/H5Ef.c | 34 ++++++ fortran/src/H5Eff.F90 | 183 ++++++++++++++++++++++++++++++-- fortran/src/H5f90proto.h | 8 ++ fortran/src/Makefile.am | 2 +- fortran/test/tH5F.F90 | 1 + fortran/test/tH5I.F90 | 7 +- src/H5Epublic.h | 4 +- 8 files changed, 232 insertions(+), 12 deletions(-) diff --git a/doxygen/examples/H5E_examples.c b/doxygen/examples/H5E_examples.c index deea838ea6b..7d3466a45e2 100644 --- a/doxygen/examples/H5E_examples.c +++ b/doxygen/examples/H5E_examples.c @@ -6,6 +6,9 @@ #include #include +#define RESET "\x1b[0m" +#define RED "\x1b[31m" + int main(void) { @@ -34,7 +37,7 @@ main(void) } // push a custom error message onto the default stack - if (H5Epush2(H5E_DEFAULT, __FILE__, __FUNCTION__, __LINE__, cls, major, minor, "Hello, Error!\n") < + if (H5Epush2(H5E_DEFAULT, __FILE__, __FUNCTION__, __LINE__, cls, major, minor, "%s Hello, error %s\n", RED, RESET) < 0) { ret_val = EXIT_FAILURE; goto fail_push; diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index 7e3a25f0938..1a238a843d9 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -251,3 +251,37 @@ h5eset_auto2_c(int_f *printflag, hid_t_f *estack_id, H5E_auto2_t func, void *cli return ret_val; } + +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 *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 ) +/******/ +{ + + 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); + + if (H5Epush2((hid_t)*err_stack, file, func, (uint)*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); + +done: + if (c_msg) + free(c_msg); + return ret_value; +} diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 4ef18c126f3..54fae903153 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -38,6 +38,7 @@ MODULE H5E USE H5GLOBAL + USE H5fortkit IMPLICIT NONE INTEGER, PARAMETER :: PRINTON = 1 !< Turn on automatic printing of errors @@ -62,17 +63,17 @@ SUBROUTINE h5eclear_f(hdferr, estack_id) INTEGER(HID_T) :: estack_id_default INTERFACE - INTEGER FUNCTION h5eclear_c(estack_id_default) BIND(C,NAME='h5eclear_c') - IMPORT :: HID_T + INTEGER(C_INT) FUNCTION H5Eclear(err_stack) BIND(C,NAME='H5Eclear2') + IMPORT :: C_INT, HID_T IMPLICIT NONE - INTEGER(HID_T) :: estack_id_default - END FUNCTION h5eclear_c + INTEGER(HID_T), VALUE :: err_stack + END FUNCTION H5Eclear END INTERFACE estack_id_default = H5E_DEFAULT_F IF(PRESENT(estack_id)) estack_id_default = estack_id - hdferr = h5eclear_c(estack_id_default) + hdferr = INT(H5Eclear(estack_id_default)) END SUBROUTINE h5eclear_f !> @@ -166,7 +167,6 @@ END FUNCTION h5eget_minor_c hdferr = h5eget_minor_c(error_no, name) END SUBROUTINE h5eget_minor_f - !> !! \ingroup FH5E !! @@ -215,5 +215,176 @@ 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, & + 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 + + 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, & + 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) :: 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, & + arg7_def = C_NULL_PTR, arg8_def = C_NULL_PTR, & + arg9_def = C_NULL_PTR, arg10_def = C_NULL_PTR, & + arg11_def = C_NULL_PTR, arg12_def = C_NULL_PTR, & + arg13_def = C_NULL_PTR, arg14_def = C_NULL_PTR, & + arg15_def = C_NULL_PTR, arg16_def = C_NULL_PTR, & + arg17_def = C_NULL_PTR, arg18_def = C_NULL_PTR, & + 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, & + arg1, arg2, arg3, arg4, arg5, & + arg6, arg7, arg8, arg9, arg10, & + arg11, arg12, arg13, arg14, arg15, & + arg16, arg17, arg18, arg19, arg20) BIND(C, NAME='h5epush_c') + + IMPORT :: C_CHAR, C_INT, C_PTR + IMPORT :: HID_T + IMPLICIT NONE + INTEGER(HID_T) :: err_stack + INTEGER(HID_T) :: cls_id + INTEGER(HID_T) :: maj_id + INTEGER(HID_T) :: min_id + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: msg + + TYPE(C_PTR), VALUE :: file + TYPE(C_PTR), VALUE :: func + INTEGER(C_INT), 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 + + 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(arg1)) arg1_def = C_LOC(arg1) + IF (PRESENT(arg2)) arg2_def = C_LOC(arg2) + IF (PRESENT(arg3)) arg3_def = C_LOC(arg3) + IF (PRESENT(arg4)) arg4_def = C_LOC(arg4) + IF (PRESENT(arg5)) arg5_def = C_LOC(arg5) + IF (PRESENT(arg6)) arg6_def = C_LOC(arg6) + IF (PRESENT(arg7)) arg7_def = C_LOC(arg7) + IF (PRESENT(arg8)) arg8_def = C_LOC(arg8) + IF (PRESENT(arg9)) arg9_def = C_LOC(arg9) + IF (PRESENT(arg10)) arg10_def = C_LOC(arg10) + IF (PRESENT(arg11)) arg11_def = C_LOC(arg11) + IF (PRESENT(arg12)) arg12_def = C_LOC(arg12) + IF (PRESENT(arg13)) arg13_def = C_LOC(arg13) + IF (PRESENT(arg14)) arg14_def = C_LOC(arg14) + IF (PRESENT(arg15)) arg15_def = C_LOC(arg15) + IF (PRESENT(arg16)) arg16_def = C_LOC(arg16) + IF (PRESENT(arg17)) arg17_def = C_LOC(arg17) + IF (PRESENT(arg18)) arg18_def = C_LOC(arg18) + 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) + + + END SUBROUTINE h5epush_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), INTENT(IN) :: 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 diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 0fe1b2017a1..d85e77ae9b7 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -559,6 +559,14 @@ H5_FCDLL int_f h5eprint_c2(void); 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, 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); /* * Functions from H5f.c diff --git a/fortran/src/Makefile.am b/fortran/src/Makefile.am index 44561f62c14..84665fdd00c 100644 --- a/fortran/src/Makefile.am +++ b/fortran/src/Makefile.am @@ -146,7 +146,7 @@ H5_buildiface.lo: $(srcdir)/H5_buildiface.F90 H5_ff.lo: $(srcdir)/H5_ff.F90 H5Fff.lo H5f90global.lo H5Aff.lo: $(srcdir)/H5Aff.F90 H5f90global.lo H5Dff.lo: $(srcdir)/H5Dff.F90 H5f90global.lo H5_ff.lo H5Sff.lo -H5Eff.lo: $(srcdir)/H5Eff.F90 H5f90global.lo +H5Eff.lo: $(srcdir)/H5Eff.F90 H5f90global.lo H5fortkit.lo H5ESff.lo: $(srcdir)/H5ESff.F90 H5f90global.lo H5Fff.lo: $(srcdir)/H5Fff.F90 H5f90global.lo H5Gff.lo: $(srcdir)/H5Gff.F90 H5f90global.lo H5Pff.lo diff --git a/fortran/test/tH5F.F90 b/fortran/test/tH5F.F90 index 569d4598c92..776959680de 100644 --- a/fortran/test/tH5F.F90 +++ b/fortran/test/tH5F.F90 @@ -1036,6 +1036,7 @@ SUBROUTINE file_close(cleanup, total_error) total_error=total_error + 1 endif CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid2, error, access_prp=fapl2) + if( error .ne. -1) then total_error = total_error + 1 write(*,*) " Open with H5F_CLOSE_SEMI should fail " diff --git a/fortran/test/tH5I.F90 b/fortran/test/tH5I.F90 index a5fedb97c95..7d97219b177 100644 --- a/fortran/test/tH5I.F90 +++ b/fortran/test/tH5I.F90 @@ -308,9 +308,12 @@ SUBROUTINE identifier_test(cleanup, total_error) ! Clear the error stack from the file close failure CALL h5eset_auto_f(1, error) CALL h5eclear_f(error) + CALL check("h5eclear_f",error,total_error) + CALL h5eclear_f(error, H5P_DEFAULT_F) + CALL check("h5eclear_f",error,total_error) - if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) RETURN END SUBROUTINE identifier_test diff --git a/src/H5Epublic.h b/src/H5Epublic.h index a22c9c6efd9..d68ac3d65d7 100644 --- a/src/H5Epublic.h +++ b/src/H5Epublic.h @@ -916,7 +916,7 @@ H5_DLL herr_t H5Ewalk1(H5E_direction_t direction, H5E_walk1_t func, void *client * error number * * \param[in] maj Major error number - * \return \herr_t + * \return Pointer to the message (success), or NULL (failure) * * \deprecated 1.8.0 Function deprecated in this release. * @@ -939,7 +939,7 @@ H5_DLL char *H5Eget_major(H5E_major_t maj); * error number * * \param[in] min Minor error number - * \return \herr_t + * \return Pointer to the message (success), or NULL (failure) * * \deprecated 1.8.0 Function deprecated and return type changed in this release. * From 9746295573339bebfd526fc0e0d10512744e729d Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Fri, 9 Feb 2024 00:43:29 +0000 Subject: [PATCH 02/31] Committing clang-format changes --- doxygen/examples/H5E_examples.c | 4 ++-- fortran/src/H5Ef.c | 39 ++++++++++++++------------------- fortran/src/H5f90proto.h | 13 +++++------ 3 files changed, 23 insertions(+), 33 deletions(-) diff --git a/doxygen/examples/H5E_examples.c b/doxygen/examples/H5E_examples.c index 7d3466a45e2..bd0ac614fbb 100644 --- a/doxygen/examples/H5E_examples.c +++ b/doxygen/examples/H5E_examples.c @@ -37,8 +37,8 @@ main(void) } // push a custom error message onto the default stack - if (H5Epush2(H5E_DEFAULT, __FILE__, __FUNCTION__, __LINE__, cls, major, minor, "%s Hello, error %s\n", RED, RESET) < - 0) { + if (H5Epush2(H5E_DEFAULT, __FILE__, __FUNCTION__, __LINE__, cls, major, minor, "%s Hello, error %s\n", + RED, RESET) < 0) { ret_val = EXIT_FAILURE; goto fail_push; } diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index 1a238a843d9..b0faca645c6 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -253,35 +253,28 @@ 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 *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 ) +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 *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) /******/ { - 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))) + 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); - if (H5Epush2((hid_t)*err_stack, file, func, (uint)*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); + if (H5Epush2((hid_t)*err_stack, file, func, (uint)*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); done: - if (c_msg) + if (c_msg) free(c_msg); - return ret_value; + return ret_value; } diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index d85e77ae9b7..e21a44c700a 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -559,14 +559,11 @@ H5_FCDLL int_f h5eprint_c2(void); 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, 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); +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, + 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); /* * Functions from H5f.c From eab3e07d317cec234294439a8609bdcc76eef5da Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Thu, 8 Feb 2024 18:58:24 -0600 Subject: [PATCH 03/31] new fortran H5E APIs --- configure.ac | 2 +- fortran/src/H5Aff.F90 | 4 +-- fortran/src/H5Eff.F90 | 52 ++++++++++++++++++++++++++++++ fortran/src/hdf5_fortrandll.def.in | 2 ++ 4 files changed, 57 insertions(+), 3 deletions(-) diff --git a/configure.ac b/configure.ac index 97d4070a7c1..78082ec0411 100644 --- a/configure.ac +++ b/configure.ac @@ -13,7 +13,7 @@ ## ---------------------------------------------------------------------- ## Initialize configure. ## -AC_PREREQ([2.71]) +AC_PREREQ([2.69]) ## AC_INIT takes the name of the package, the version number, and an ## email address to report bugs. AC_CONFIG_SRCDIR takes a unique file diff --git a/fortran/src/H5Aff.F90 b/fortran/src/H5Aff.F90 index a55773a0c1f..c2de9853f20 100644 --- a/fortran/src/H5Aff.F90 +++ b/fortran/src/H5Aff.F90 @@ -591,8 +591,8 @@ SUBROUTINE h5aclose_f(attr_id, hdferr) INTEGER, INTENT(OUT) :: hdferr INTERFACE - INTEGER FUNCTION H5Aclose(attr_id) BIND(C, NAME='H5Aclose') - IMPORT :: HID_T + INTEGER(C_INT) FUNCTION H5Aclose(attr_id) BIND(C, NAME='H5Aclose') + IMPORT :: HID_T, C_INT IMPLICIT NONE INTEGER(HID_T), INTENT(IN), VALUE :: attr_id END FUNCTION H5Aclose diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 54fae903153..82119bd4bcd 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -309,6 +309,58 @@ END FUNCTION h5epush_c END SUBROUTINE h5epush_f + SUBROUTINE h5eregister_class_f(cls_name, lib_name, version, class_id, hdferr) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: cls_name + CHARACTER(LEN=*), INTENT(IN) :: lib_name + CHARACTER(LEN=*), INTENT(IN) :: version + INTEGER(HID_T) , INTENT(OUT) :: class_id + INTEGER, INTENT(OUT) :: hdferr + + CHARACTER(LEN=LEN_TRIM(cls_name)+1,KIND=C_CHAR) :: c_cls_name + CHARACTER(LEN=LEN_TRIM(lib_name)+1,KIND=C_CHAR) :: c_lib_name + CHARACTER(LEN=LEN_TRIM(version)+1,KIND=C_CHAR) :: c_version + INTERFACE + INTEGER(HID_T) FUNCTION H5Eregister_class(cls_name, lib_name, version) & + BIND(C,NAME='H5Eregister_class') + IMPORT :: C_CHAR + IMPORT :: HID_T + IMPLICIT NONE + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: cls_name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: lib_name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: version + + END FUNCTION H5Eregister_class + END INTERFACE + + c_cls_name = TRIM(cls_name)//C_NULL_CHAR + c_lib_name = TRIM(lib_name)//C_NULL_CHAR + c_version = TRIM(version)//C_NULL_CHAR + + class_id = H5Eregister_class(c_cls_name, c_lib_name, c_version) + + hdferr = 0 + IF(class_id.LT.0) hdferr = -1 + + END SUBROUTINE h5eregister_class_f + + SUBROUTINE h5eunregister_class_f(class_id, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: class_id + INTEGER, INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5Eunregister_class(class_id) BIND(C, NAME='H5Eunregister_class') + IMPORT :: HID_T, C_INT + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN), VALUE :: class_id + END FUNCTION H5Eunregister_class + END INTERFACE + + hdferr = INT(H5Eunregister_class(class_id)) + + END SUBROUTINE h5eunregister_class_f + #if 0 !> !! \ingroup FH5E diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index e29488f8cee..6d2f452b000 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -110,6 +110,8 @@ H5E_mp_H5EPRINT_F H5E_mp_H5EGET_MAJOR_F H5E_mp_H5EGET_MINOR_F H5E_mp_H5ESET_AUTO_F +H5E_mp_H5EREGISTER_CLASS_F +H5E_mp_H5EUNREGISTER_CLASS_F ; H5ES H5ES_mp_H5ESCREATE_F H5ES_mp_H5ESGET_COUNT_F From e475b0fd8e21fc63a2b512cd58aca72fc6a5bc70 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Thu, 8 Feb 2024 22:39:32 -0600 Subject: [PATCH 04/31] fixed H5Eget_minor --- fortran/src/H5Ef.c | 4 +- fortran/src/H5Eff.F90 | 102 +++++++++++++++++++++------ fortran/src/H5f90proto.h | 2 +- fortran/src/hdf5_fortrandll.def.in | 2 + fortran/test/fortranlib_test_F03.F90 | 4 ++ fortran/test/tH5E_F03.F90 | 49 +++++++++++++ src/H5Epublic.h | 2 +- 7 files changed, 139 insertions(+), 26 deletions(-) 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 From 7f76e1caf5ae64b7d1b6c19011390af5ae8e3ab8 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Fri, 9 Feb 2024 04:41:01 +0000 Subject: [PATCH 05/31] Committing clang-format changes --- fortran/src/H5Ef.c | 7 ++++--- fortran/src/H5f90proto.h | 9 +++++---- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index b086357d2eb..f0f21cca973 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -254,9 +254,10 @@ 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, 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) + 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/H5f90proto.h b/fortran/src/H5f90proto.h index 70a15880d05..6ad5a1af0dc 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -560,10 +560,11 @@ 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, 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); + 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); /* * Functions from H5f.c From b066b33e7f496580c35e17314297037f8d66cdb3 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Wed, 14 Feb 2024 15:24:26 -0600 Subject: [PATCH 06/31] new API --- fortran/src/H5Eff.F90 | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 2f1d2bcd0b0..c821d978df6 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -417,6 +417,47 @@ END FUNCTION H5Eclose_msg END SUBROUTINE h5eclose_msg_f + SUBROUTINE H5Eget_msg_f(msg_id, msg_type, msg, msg_size, hdferr, req_size) + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: msg_id + INTEGER , INTENT(OUT) :: msg_type + CHARACTER(LEN=*), INTENT(OUT) :: msg + INTEGER(SIZE_T) , INTENT(OUT) :: msg_size + INTEGER , INTENT(OUT) :: hdferr + INTEGER(SIZE_T) , INTENT(INOUT), OPTIONAL :: req_size + + CHARACTER(LEN=LEN_TRIM(msg)+1,KIND=C_CHAR) :: c_msg + INTEGER(C_INT) :: c_msg_type + TYPE(C_PTR) :: f_ptr + + INTERFACE + INTEGER(SIZE_T) FUNCTION H5Eget_msg(msg_id, msg_type, msg, size) & + BIND(C,NAME='H5Eget_msg') + IMPORT :: C_CHAR, C_INT + IMPORT :: HID_T + IMPLICIT NONE + INTEGER(HID_T), VALUE :: msg_id + INTEGER(C_INT) :: msg_type + TYPE(C_PTR) , VALUE :: msg + INTEGER(SIZE_T), VALUE :: size + END FUNCTION H5Eget_msg + END INTERFACE + + IF(PRESENT(req_size))THEN + msg_size = H5Eget_msg_f(msg_id, c_msg_type, C_NULL_PTR, 0) + ELSE + msg_size = H5Eget_msg_f(msg_id, c_msg_type, f_ptr, size) + ENDIF + + msg_type = INT(msg_type) + + hdferr = 0 + IF(msg_size.LT.0) & + hdferr = -1 + + END SUBROUTINE H5Eget_msg_f + #if 0 !> !! \ingroup FH5E From 4d3d7c611c440769fdfa65007637c90b8183bec3 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Thu, 15 Feb 2024 18:41:09 -0600 Subject: [PATCH 07/31] H5Eget_msg --- config/cmake/H5pubconf.h.in | 3 ++ config/cmake/HDF5UseFortran.cmake | 9 +++++ config/cmake/HDFUseFortran.cmake | 8 +++++ configure.ac | 10 ++++++ fortran/src/CMakeLists.txt | 5 +++ fortran/src/H5Eff.F90 | 55 +++++++++++++++++++++++-------- fortran/src/H5Pff.F90 | 4 +-- fortran/src/H5VLff.F90 | 2 +- fortran/src/H5config_f.inc.cmake | 3 ++ fortran/src/H5config_f.inc.in | 3 ++ fortran/src/H5fortkit.F90 | 20 +++++++---- fortran/src/Makefile.am | 1 + fortran/test/tH5E.F90 | 2 -- fortran/test/tH5E_F03.F90 | 28 +++++++++++++--- m4/aclocal_fc.f90 | 4 +++ m4/aclocal_fc.m4 | 12 +++++++ 16 files changed, 140 insertions(+), 29 deletions(-) diff --git a/config/cmake/H5pubconf.h.in b/config/cmake/H5pubconf.h.in index 9fc9ae1143d..a0c00477f04 100644 --- a/config/cmake/H5pubconf.h.in +++ b/config/cmake/H5pubconf.h.in @@ -65,6 +65,9 @@ /* Define if we have Fortran intrinsic STORAGE_SIZE */ #cmakedefine H5_FORTRAN_HAVE_STORAGE_SIZE @H5_FORTRAN_HAVE_STORAGE_SIZE@ +/* Define if Fortran supports allocatable character */ +#cmakedefine H5_FORTRAN_HAVE_CHAR_ALLOC @H5_FORTRAN_HAVE_CHAR_ALLOC@ + /* Determine the size of C long double */ #cmakedefine H5_FORTRAN_SIZEOF_LONG_DOUBLE @H5_FORTRAN_SIZEOF_LONG_DOUBLE@ diff --git a/config/cmake/HDF5UseFortran.cmake b/config/cmake/HDF5UseFortran.cmake index 3e058adbf83..1e191d1f821 100644 --- a/config/cmake/HDF5UseFortran.cmake +++ b/config/cmake/HDF5UseFortran.cmake @@ -114,6 +114,15 @@ else () message (FATAL_ERROR "Fortran compiler requires either intrinsic functions SIZEOF or STORAGE_SIZE") endif () +# Check to see of Fortran supports allocatable character +READ_SOURCE("PROGRAM PROG_CHAR_ALLOC" "END PROGRAM PROG_CHAR_ALLOC" SOURCE_CODE) +check_fortran_source_compiles (${SOURCE_CODE} FORTRAN_CHAR_ALLOC SRC_EXT f90) +if (${FORTRAN_CHAR_ALLOC}) + set (${HDF_PREFIX}_FORTRAN_HAVE_CHAR_ALLOC 1) +else () + set (${HDF_PREFIX}_FORTRAN_HAVE_CHAR_ALLOC 0) +endif () + #----------------------------------------------------------------------------- # Determine the available KINDs for REALs and INTEGERs #----------------------------------------------------------------------------- diff --git a/config/cmake/HDFUseFortran.cmake b/config/cmake/HDFUseFortran.cmake index 61adffd198f..c05d06db77a 100644 --- a/config/cmake/HDFUseFortran.cmake +++ b/config/cmake/HDFUseFortran.cmake @@ -72,6 +72,13 @@ set (STORAGE_SIZE_CODE END PROGRAM " ) +set (CHAR_ALLOC + " + PROGRAM main + CHARACTER(:), ALLOCATABLE :: str + END PROGRAM + " +) set (ISO_FORTRAN_ENV_CODE " PROGRAM main @@ -126,6 +133,7 @@ check_fortran_source_compiles (${STORAGE_SIZE_CODE} ${HDF_PREFIX}_FORTRAN_HAVE_S check_fortran_source_compiles (${ISO_FORTRAN_ENV_CODE} ${HDF_PREFIX}_HAVE_ISO_FORTRAN_ENV SRC_EXT f90) check_fortran_source_compiles (${REALISNOTDOUBLE_CODE} ${HDF_PREFIX}_FORTRAN_DEFAULT_REAL_NOT_DOUBLE SRC_EXT f90) check_fortran_source_compiles (${ISO_C_BINDING_CODE} ${HDF_PREFIX}_FORTRAN_HAVE_ISO_C_BINDING SRC_EXT f90) +check_fortran_source_compiles (${CHAR_ALLOC} ${HDF_PREFIX}_FORTRAN_HAVE_CHAR_ALLOC SRC_EXT f90) #----------------------------------------------------------------------------- # Add debug information (intel Fortran : JB) diff --git a/configure.ac b/configure.ac index 78082ec0411..0bee185c822 100644 --- a/configure.ac +++ b/configure.ac @@ -652,6 +652,12 @@ if test "X$HDF_FORTRAN" = "Xyes"; then if test "X$HAVE_F2003_REQUIREMENTS" = "Xno"; then AC_MSG_ERROR([Fortran compiler lacks required Fortran 2003 features; unsupported Fortran 2003 compiler, remove --enable-fortran]) fi + ## Checking if the compiler supports fortran character being allocatable + PAC_HAVE_CHAR_ALLOC + + if test "X$HAVE_CHAR_ALLOC_FORTRAN" = "Xno"; then + AC_MSG_ERROR([Fortran compiler lacks required Fortran 2003 features; unsupported Fortran 2003 compiler, remove --enable-fortran]) + fi ## -------------------------------------------------------------------- ## Define wrappers for the C compiler to use Fortran function names @@ -740,6 +746,10 @@ if test "X$HDF_FORTRAN" = "Xyes"; then AC_DEFINE([FORTRAN_HAVE_SIZEOF], [1], [Define if we have Fortran intrinsic SIZEOF]) fi + if test "X$HAVE_CHAR_ALLOC_FORTRAN" = "Xyes"; then + AC_DEFINE([FORTRAN_HAVE_CHAR_ALLOC], [1], [Define if Fortran supports allocatable character]) + fi + ## See if C_LONG_DOUBLE is available PAC_PROG_FC_HAVE_C_LONG_DOUBLE diff --git a/fortran/src/CMakeLists.txt b/fortran/src/CMakeLists.txt index 4c280469056..99644b83fbb 100644 --- a/fortran/src/CMakeLists.txt +++ b/fortran/src/CMakeLists.txt @@ -63,6 +63,11 @@ if (H5_FORTRAN_HAVE_C_SIZEOF) set (CMAKE_H5_FORTRAN_HAVE_C_SIZEOF 1) endif () +set (CMAKE_H5_FORTRAN_HAVE_CHAR_ALLOC 0) +if (H5_FORTRAN_HAVE_CHAR_ALLOC) + set (CMAKE_H5_FORTRAN_HAVE_CHAR_ALLOC 1) +endif () + configure_file (${HDF5_F90_SRC_SOURCE_DIR}/H5config_f.inc.cmake ${HDF5_F90_BINARY_DIR}/H5config_f.inc @ONLY) configure_file (${HDF5_F90_SRC_SOURCE_DIR}/H5fort_type_defines.h.cmake ${HDF5_F90_BINARY_DIR}/H5fort_type_defines.h @ONLY) diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index c821d978df6..3b16ce7f60e 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -417,25 +417,26 @@ END FUNCTION H5Eclose_msg END SUBROUTINE h5eclose_msg_f - SUBROUTINE H5Eget_msg_f(msg_id, msg_type, msg, msg_size, hdferr, req_size) + SUBROUTINE H5Eget_msg_f(msg_id, msg_type, msg, hdferr, msg_size) IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: msg_id INTEGER , INTENT(OUT) :: msg_type CHARACTER(LEN=*), INTENT(OUT) :: msg - INTEGER(SIZE_T) , INTENT(OUT) :: msg_size INTEGER , INTENT(OUT) :: hdferr - INTEGER(SIZE_T) , INTENT(INOUT), OPTIONAL :: req_size + INTEGER(SIZE_T) , INTENT(INOUT), OPTIONAL :: msg_size - CHARACTER(LEN=LEN_TRIM(msg)+1,KIND=C_CHAR) :: c_msg + CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(:), ALLOCATABLE, TARGET :: c_msg INTEGER(C_INT) :: c_msg_type TYPE(C_PTR) :: f_ptr + INTEGER(SIZE_T) :: msg_cp_sz + INTEGER(SIZE_T) :: c_msg_size INTERFACE INTEGER(SIZE_T) FUNCTION H5Eget_msg(msg_id, msg_type, msg, size) & BIND(C,NAME='H5Eget_msg') - IMPORT :: C_CHAR, C_INT - IMPORT :: HID_T + IMPORT :: C_CHAR, C_PTR, C_INT + IMPORT :: HID_T, SIZE_T IMPLICIT NONE INTEGER(HID_T), VALUE :: msg_id INTEGER(C_INT) :: msg_type @@ -444,17 +445,43 @@ INTEGER(SIZE_T) FUNCTION H5Eget_msg(msg_id, msg_type, msg, size) & END FUNCTION H5Eget_msg END INTERFACE - IF(PRESENT(req_size))THEN - msg_size = H5Eget_msg_f(msg_id, c_msg_type, C_NULL_PTR, 0) - ELSE - msg_size = H5Eget_msg_f(msg_id, c_msg_type, f_ptr, size) + hdferr = 0 + msg_cp_sz = 0 + IF(PRESENT(msg_size))THEN + IF(msg_size .EQ. 0)THEN + c_msg_size = H5Eget_msg(msg_id, c_msg_type, C_NULL_PTR, 0_SIZE_T) + + IF(PRESENT(msg_size)) msg_size = c_msg_size + msg_type = INT(c_msg_type) + + IF(c_msg_size.LT.0) hdferr = -1 + RETURN + ELSE + msg_cp_sz = msg_size + ENDIF ENDIF - msg_type = INT(msg_type) + IF(msg_cp_sz.EQ.0) msg_cp_sz = LEN(msg) - hdferr = 0 - IF(msg_size.LT.0) & - hdferr = -1 + ALLOCATE(c_msg(1:msg_cp_sz+1), stat=hdferr) + IF (hdferr .NE. 0) THEN + hdferr = -1 + 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) + + CALL HD5c2fstring(msg, c_msg, msg_cp_sz, msg_cp_sz+1_SIZE_T) + + DEALLOCATE(c_msg) + + IF(PRESENT(msg_size))THEN + msg_size = c_msg_size + ENDIF + + msg_type = INT(c_msg_type) + + IF(c_msg_size.LT.0) hdferr = -1 END SUBROUTINE H5Eget_msg_f diff --git a/fortran/src/H5Pff.F90 b/fortran/src/H5Pff.F90 index 90a74f7cf4f..516c34b99f1 100644 --- a/fortran/src/H5Pff.F90 +++ b/fortran/src/H5Pff.F90 @@ -6250,7 +6250,7 @@ END FUNCTION h5pget_virtual_filename IF(INT(h5pget_virtual_filename(dcpl_id, index, f_ptr, INT(LEN(name)+1,SIZE_T)), SIZE_T).LT.0)THEN hdferr = -1 ELSE - CALL HD5c2fstring(name,c_name,LEN(name)) + CALL HD5c2fstring(name, c_name, LEN(name,KIND=SIZE_T), LEN(name,KIND=SIZE_T)+1_SIZE_T ) ENDIF ENDIF @@ -6304,7 +6304,7 @@ END FUNCTION h5pget_virtual_dsetname IF(INT(h5pget_virtual_dsetname(dcpl_id, index, f_ptr, INT(LEN(name)+1,SIZE_T)), SIZE_T).LT.0)THEN hdferr = -1 ELSE - CALL HD5c2fstring(name,c_name,LEN(name)) + CALL HD5c2fstring(name, c_name, LEN(name,KIND=SIZE_T), LEN(name,KIND=SIZE_T)+1_SIZE_T ) ENDIF ENDIF diff --git a/fortran/src/H5VLff.F90 b/fortran/src/H5VLff.F90 index 4467a59b171..66d098bfab6 100644 --- a/fortran/src/H5VLff.F90 +++ b/fortran/src/H5VLff.F90 @@ -343,7 +343,7 @@ END FUNCTION H5VLget_connector_name IF(INT(H5VLget_connector_name(obj_id, c_name, l), SIZE_T).LT.0)THEN hdferr = H5I_INVALID_HID_F ELSE - CALL HD5c2fstring(name,c_name,LEN(name)) + CALL HD5c2fstring(name, c_name, LEN(name,KIND=SIZE_T), LEN(name,KIND=SIZE_T)+1_SIZE_T ) ENDIF ENDIF diff --git a/fortran/src/H5config_f.inc.cmake b/fortran/src/H5config_f.inc.cmake index e6fa7b93503..94e8b33878b 100644 --- a/fortran/src/H5config_f.inc.cmake +++ b/fortran/src/H5config_f.inc.cmake @@ -67,6 +67,9 @@ #define H5_FORTRAN_HAVE_C_SIZEOF #endif +! Define if allocatable character is supported +#define H5_FORTRAN_HAVE_CHAR_ALLOC @H5_FORTRAN_HAVE_CHAR_ALLOC@ + ! Define if the intrinsic function C_LONG_DOUBLE exists #define H5_FORTRAN_HAVE_C_LONG_DOUBLE @H5_FORTRAN_HAVE_C_LONG_DOUBLE@ diff --git a/fortran/src/H5config_f.inc.in b/fortran/src/H5config_f.inc.in index 7f522558b55..3970596687f 100644 --- a/fortran/src/H5config_f.inc.in +++ b/fortran/src/H5config_f.inc.in @@ -35,6 +35,9 @@ ! Define if the intrinsic function C_SIZEOF exists #undef FORTRAN_HAVE_C_SIZEOF +! Define if Fortran supports allocatable character +#undef FORTRAN_HAVE_CHAR_ALLOC + ! Define if the intrinsic function C_LONG_DOUBLE exists #undef FORTRAN_HAVE_C_LONG_DOUBLE diff --git a/fortran/src/H5fortkit.F90 b/fortran/src/H5fortkit.F90 index b745c22e5ee..c363bc0deec 100644 --- a/fortran/src/H5fortkit.F90 +++ b/fortran/src/H5fortkit.F90 @@ -25,6 +25,8 @@ !***** MODULE H5fortkit + USE H5FORTRAN_TYPES, ONLY : SIZE_T + CONTAINS !****if* H5fortkit/HD5c2fstring @@ -43,17 +45,23 @@ MODULE H5fortkit ! length greater than one, which is why we use the array of characters instead. ! ! SOURCE - SUBROUTINE HD5c2fstring(fstring,cstring,len) + SUBROUTINE HD5c2fstring(fstring,cstring,flen,clen) !***** IMPLICIT NONE - INTEGER :: i - INTEGER :: len - CHARACTER(LEN=len) :: fstring - CHARACTER(LEN=1), DIMENSION(1:len) :: cstring + INTEGER(SIZE_T) :: i + INTEGER(SIZE_T) :: flen + INTEGER(SIZE_T) :: clen + CHARACTER(*) :: fstring + CHARACTER(LEN=1), DIMENSION(1:clen) :: cstring + + INTEGER(SIZE_T) :: flen_max fstring = '' - DO i = 1, len + flen_max = LEN(fstring, KIND=SIZE_T) + DO i = 1, clen + IF (i .GT. flen_max) EXIT + IF (i .GT. flen) EXIT IF (cstring(i)(1:1)==CHAR(0)) EXIT fstring(i:i) = cstring(i)(1:1) END DO diff --git a/fortran/src/Makefile.am b/fortran/src/Makefile.am index 84665fdd00c..8d8396fcbff 100644 --- a/fortran/src/Makefile.am +++ b/fortran/src/Makefile.am @@ -143,6 +143,7 @@ FORTRAN_API=yes # modules they depend upon are actually made. *sigh* H5f90global.lo: $(srcdir)/H5f90global.F90 H5fortran_types.lo H5_buildiface.lo: $(srcdir)/H5_buildiface.F90 +H5fortkit.lo: $(srcdir)/H5fortkit.F90 H5fortran_types.lo H5_ff.lo: $(srcdir)/H5_ff.F90 H5Fff.lo H5f90global.lo H5Aff.lo: $(srcdir)/H5Aff.F90 H5f90global.lo H5Dff.lo: $(srcdir)/H5Dff.F90 H5f90global.lo H5_ff.lo H5Sff.lo diff --git a/fortran/test/tH5E.F90 b/fortran/test/tH5E.F90 index 0550bc8778e..5cf761477d6 100644 --- a/fortran/test/tH5E.F90 +++ b/fortran/test/tH5E.F90 @@ -48,8 +48,6 @@ SUBROUTINE error_report_test(cleanup, total_error) CHARACTER(LEN=8), PARAMETER :: err_filename = "err_file"! Error output file CHARACTER(LEN=80) :: fix_err_filename - - INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: grp_id ! Group identifier INTEGER :: error, tmp_error, err_flag diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 80bc8d1b280..4e33d8265d4 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -208,14 +208,20 @@ SUBROUTINE test_error_stack(total_error) CHARACTER(LEN=18), TARGET :: func INTEGER , TARGET :: line TYPE(C_PTR) :: ptr1, ptr2, ptr3 - CHARACTER(LEN=180) :: name + + INTEGER :: msg_type + CHARACTER(LEN=9) :: maj_mesg = "MAJOR MSG" + CHARACTER(LEN=7) :: min_mesg = "MIN MSG" + + CHARACTER(LEN=9) :: chr9 + INTEGER(SIZE_T) :: msg_size 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 H5Ecreate_msg_f(cls_id, H5E_MAJOR_F, maj_mesg, major, error) CALL check("H5Ecreate_msg_f", error, total_error) - CALL H5Ecreate_msg_f(cls_id, H5E_MINOR_F, "Oops!", minor, 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 @@ -227,12 +233,26 @@ SUBROUTINE test_error_stack(total_error) 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, & + CALL H5Epush_f(H5E_DEFAULT_F, cls_id, major, minor, "%s ERROR TEXT %s"//C_NEW_LINE, error, & ptr1, ptr2, ptr3, & arg1=ACHAR(27)//"[31m", arg2=ACHAR(27)//"[0m" ) CALL check("H5Epush_f", error, total_error) + msg_size = 0 + CALL H5Eget_msg_f(major, msg_type, chr9, error, msg_size) + CALL check("H5Eget_msg_f", error, total_error) + CALL VERIFY("H5Eget_msg_f", msg_type, H5E_MAJOR_F, total_error) + CALL VERIFY("H5Eget_msg_f", msg_size, 9_SIZE_T, total_error) + + ! Check when a shorter buffer length is passed as the msg_size + msg_size = 3 + CALL H5Eget_msg_f(major, msg_type, chr9, error, msg_size) + CALL check("H5Eget_msg_f", error, total_error) + CALL VERIFY("H5Eget_msg_f", msg_type, H5E_MAJOR_F, total_error) + CALL VERIFY("H5Eget_msg_f", msg_size, 9_SIZE_T, total_error) + CALL VERIFY("H5Eget_msg_f", TRIM(chr9), maj_mesg(1:3), total_error) + CALL h5eprint_f(error) !, "stderr") CALL check("h5eprint_f", error, total_error) diff --git a/m4/aclocal_fc.f90 b/m4/aclocal_fc.f90 index 68a8f1b590c..c9de4bc7f6d 100644 --- a/m4/aclocal_fc.f90 +++ b/m4/aclocal_fc.f90 @@ -55,6 +55,10 @@ PROGRAM PROG_FC_HAVE_F2003_REQUIREMENTS ptr = C_LOC(ichr(1:1)) END PROGRAM PROG_FC_HAVE_F2003_REQUIREMENTS +PROGRAM PROG_CHAR_ALLOC + CHARACTER(:), ALLOCATABLE :: str +END PROGRAM PROG_CHAR_ALLOC + !---- START ----- Check to see C_LONG_DOUBLE is different from C_DOUBLE MODULE type_mod USE ISO_C_BINDING diff --git a/m4/aclocal_fc.m4 b/m4/aclocal_fc.m4 index 5d7bca9be30..0cc25a6e42d 100644 --- a/m4/aclocal_fc.m4 +++ b/m4/aclocal_fc.m4 @@ -106,6 +106,18 @@ AC_DEFUN([PAC_PROG_FC_STORAGE_SIZE],[ ]) +dnl See if the fortran compiler supports allocatable character + +AC_DEFUN([PAC_HAVE_CHAR_ALLOC],[ + HAVE_CHAR_ALLOC_FORTRAN="no" + AC_MSG_CHECKING([if Fortran compiler supports allocatable character]) + TEST_SRC="`sed -ne '/PROGRAM PROG_CHAR_ALLOC/,/END PROGRAM PROG_CHAR_ALLOC/p' $srcdir/m4/aclocal_fc.f90`" + AC_LINK_IFELSE([$TEST_SRC], [AC_MSG_RESULT([yes]) + HAVE_CHAR_ALLOC_FORTRAN="yes"], + [AC_MSG_RESULT([no])]) + +]) + dnl Check to see C_LONG_DOUBLE is available AC_DEFUN([PAC_PROG_FC_HAVE_C_LONG_DOUBLE],[ From b79e09e8ed07c3f868bd931b5428754e2745368f Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 16 Feb 2024 00:09:31 -0600 Subject: [PATCH 08/31] added testing --- fortran/src/H5Eff.F90 | 51 ++++++++++++++++---- fortran/test/tH5E_F03.F90 | 98 ++++++++++++++++++++++++++++++++++++++- 2 files changed, 140 insertions(+), 9 deletions(-) diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 3b16ce7f60e..ba271cf707d 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -84,6 +84,9 @@ END SUBROUTINE h5eclear_f !! \param hdferr \fortran_error !! \param name Name of the file that contains print output !! +!! \note If \p name is not specified, the output will be sent to +!! the standard error (stderr). +!! !! See C API: @ref H5Eprint2() !! SUBROUTINE h5eprint_f(hdferr, name) @@ -219,7 +222,39 @@ END FUNCTION h5eset_auto2_c hdferr = h5eset_auto2_c(printflag, estack_id_default, func_default, client_data_default) END SUBROUTINE h5eset_auto_f - +!> +!! \ingroup FH5E +!! +!! \brief Pushes a new error record onto an error stack. +!! +!! \param err_stack Error stack identifier. If the identifier is H5E_DEFAULT_F, the error +!! record will be pushed to the current stack. +!! \param cls_id Error class identifier +!! \param maj_id Major error identifier +!! \param min_id Minor error identifier +!! \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 arg[1-20] 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(). +!! Furthermore, special characters, such as ANSI escapes, +!! will only be interpreted correctly if the Fortran equivalent +!! is used. For example, to print \p msg "TEXT" in red and has +!! a space after the text would be: +!!

+!! \code +!! (..., "%s TEXT %s"//C_NEW_LINE, hdferr, ..., arg1=ACHAR(27)//"[31m", arg2=ACHAR(27)//"[0m" ) +!! \endcode +!!
Using "\n" instead of C_NEW_LINE will not be interpereted correctly, and similary, +!! using "\x1B" instead of ACHAR(27) +!! +!! +!! See C API: @ref H5Epush2() +!! 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, & @@ -232,9 +267,9 @@ SUBROUTINE h5epush_f(err_stack, cls_id, maj_id, min_id, msg, hdferr, & CHARACTER(LEN=*), INTENT(IN) :: msg INTEGER, INTENT(OUT) :: hdferr - TYPE(C_PTR), OPTIONAL, INTENT(IN) :: file - TYPE(C_PTR), OPTIONAL, INTENT(IN) :: func - TYPE(C_PTR), OPTIONAL, INTENT(IN) :: line + 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 @@ -420,10 +455,10 @@ END SUBROUTINE h5eclose_msg_f SUBROUTINE H5Eget_msg_f(msg_id, msg_type, msg, hdferr, msg_size) IMPLICIT NONE - INTEGER(HID_T) , INTENT(IN) :: msg_id - INTEGER , INTENT(OUT) :: msg_type - CHARACTER(LEN=*), INTENT(OUT) :: msg - INTEGER , INTENT(OUT) :: hdferr + INTEGER(HID_T) , INTENT(IN) :: msg_id + INTEGER , INTENT(OUT) :: msg_type + CHARACTER(LEN=*) :: msg + INTEGER , INTENT(OUT) :: hdferr INTEGER(SIZE_T) , INTENT(INOUT), OPTIONAL :: msg_size CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(:), ALLOCATABLE, TARGET :: c_msg diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 4e33d8265d4..733f2d3ce0c 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -212,6 +212,14 @@ SUBROUTINE test_error_stack(total_error) INTEGER :: msg_type CHARACTER(LEN=9) :: maj_mesg = "MAJOR MSG" CHARACTER(LEN=7) :: min_mesg = "MIN MSG" + !file status + LOGICAL :: status + CHARACTER(LEN=180) :: chr180 + INTEGER :: idx + +#ifdef H5_FORTRAN_HAVE_CHAR_ALLOC + CHARACTER(:), ALLOCATABLE :: msg_alloc +#endif CHARACTER(LEN=9) :: chr9 INTEGER(SIZE_T) :: msg_size @@ -253,9 +261,97 @@ SUBROUTINE test_error_stack(total_error) CALL VERIFY("H5Eget_msg_f", msg_size, 9_SIZE_T, total_error) CALL VERIFY("H5Eget_msg_f", TRIM(chr9), maj_mesg(1:3), total_error) - CALL h5eprint_f(error) !, "stderr") + ! Check when a exact size buffer length is passed as the msg_size + msg_size = 9 + CALL H5Eget_msg_f(major, msg_type, chr9, error, msg_size) + CALL check("H5Eget_msg_f", error, total_error) + CALL VERIFY("H5Eget_msg_f", msg_type, H5E_MAJOR_F, total_error) + CALL VERIFY("H5Eget_msg_f", msg_size, 9_SIZE_T, total_error) + CALL VERIFY("H5Eget_msg_f", TRIM(chr9), maj_mesg(1:9), total_error) + + msg_size = 0 + CALL H5Eget_msg_f(minor, msg_type, chr9, error, msg_size) + CALL check("H5Eget_msg_f", error, total_error) + CALL VERIFY("H5Eget_msg_f", msg_type, H5E_MINOR_F, total_error) + CALL VERIFY("H5Eget_msg_f", msg_size, 7_SIZE_T, total_error) + + ! Check when a shorter buffer length is passed as the msg_size + msg_size = 3 + CALL H5Eget_msg_f(minor, msg_type, chr9, error, msg_size) + CALL check("H5Eget_msg_f", error, total_error) + CALL VERIFY("H5Eget_msg_f", msg_type, H5E_MINOR_F, total_error) + CALL VERIFY("H5Eget_msg_f", msg_size, 7_SIZE_T, total_error) + CALL VERIFY("H5Eget_msg_f", TRIM(chr9), min_mesg(1:3), total_error) + + ! Check when a larger buffer length is passed as the msg_size + msg_size = 9 + CALL H5Eget_msg_f(minor, msg_type, chr9, error, msg_size) + CALL check("H5Eget_msg_f", error, total_error) + CALL VERIFY("H5Eget_msg_f", msg_type, H5E_MINOR_F, total_error) + CALL VERIFY("H5Eget_msg_f", msg_size, 7_SIZE_T, total_error) + CALL VERIFY("H5Eget_msg_f", TRIM(chr9), min_mesg(1:7), total_error) + + ! Check with an allocatable character of the exact size +#ifdef H5_FORTRAN_HAVE_CHAR_ALLOC + msg_size = 0 + CALL H5Eget_msg_f(minor, msg_type, "", error, msg_size) + CALL check("H5Eget_msg_f", error, total_error) + CALL VERIFY("H5Eget_msg_f", msg_type, H5E_MINOR_F, total_error) + CALL VERIFY("H5Eget_msg_f", msg_size, 7_SIZE_T, total_error) + + ALLOCATE(CHARACTER(LEN=msg_size) :: msg_alloc) + CALL H5Eget_msg_f(minor, msg_type, msg_alloc, error) + CALL check("H5Eget_msg_f", error, total_error) + CALL VERIFY("H5Eget_msg_f", msg_type, H5E_MINOR_F, total_error) + CALL VERIFY("H5Eget_msg_f", msg_alloc, min_mesg, total_error) +#endif + + INQUIRE(file="H5Etest.txt", EXIST=status) + IF(status)THEN + OPEN(UNIT=12, FILE="H5Etest.txt", status='old') + CLOSE(12, STATUS='delete') + ENDIF + + 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) + ELSE + OPEN(UNIT=12, FILE="H5Etest.txt", status='old') + + READ(12,'(A)') chr180 + idx = INDEX(string=chr180,substring="Custom error class") + IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + idx = INDEX(string=chr180,substring="H5E_F03") + IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + idx = INDEX(string=chr180,substring="0.1") + IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + + READ(12,'(A)') chr180 + idx = INDEX(string=chr180,substring="FILE") + IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + idx = INDEX(string=chr180,substring="99") + IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + idx = INDEX(string=chr180,substring="FUNC") + IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + idx = INDEX(string=chr180,substring="ERROR TEXT") + IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + + READ(12,'()') + + READ(12,"(A)") chr180 + idx = INDEX(string=chr180,substring=maj_mesg) + IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + + READ(12,"(A)") chr180 + idx = INDEX(string=chr180,substring=min_mesg) + IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + + CLOSE(12, STATUS='delete') + ENDIF + CALL H5Eclose_msg_f(major, error) CALL check("H5Eclose_msg_f", error, total_error) CALL H5Eclose_msg_f(minor, error) From c287ec7aab757cd94465e2ee691ef2b1ff669cd2 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 16 Feb 2024 00:15:23 -0600 Subject: [PATCH 09/31] added testing --- fortran/src/H5Eff.F90 | 2 +- fortran/src/H5fortkit.F90 | 7 ++++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index ba271cf707d..5bcb1c2289a 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -249,7 +249,7 @@ END SUBROUTINE h5eset_auto_f !! \code !! (..., "%s TEXT %s"//C_NEW_LINE, hdferr, ..., arg1=ACHAR(27)//"[31m", arg2=ACHAR(27)//"[0m" ) !! \endcode -!!
Using "\n" instead of C_NEW_LINE will not be interpereted correctly, and similary, +!!
Using "\n" instead of C_NEW_LINE will not be interpereted correctly, and similarly, !! using "\x1B" instead of ACHAR(27) !! !! diff --git a/fortran/src/H5fortkit.F90 b/fortran/src/H5fortkit.F90 index c363bc0deec..24af43d605c 100644 --- a/fortran/src/H5fortkit.F90 +++ b/fortran/src/H5fortkit.F90 @@ -34,11 +34,12 @@ MODULE H5fortkit ! HD5c2fstring ! INPUTS ! cstring - C string stored as a string array of size 'len' of string size LEN=1 -! len - length of Fortran string +! flen - length of Fortran string +! clen - length of C array ! OUTPUT -! fstring - Fortran string array of LEN=1 +! fstring - Fortran string LEN=1 ! PURPOSE -! Copies a Fortran array of strings having a length of one to a fortran string and removes the C Null +! Copies a C array of strings having a length of one to a fortran string and removes the C Null ! terminator. The Null terminator is returned from C when calling the C APIs directly. ! ! The fortran standard does not allow C_LOC to be used on a character string of From c965f445bfd4d63f16a9c92810b566ab7b350001 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 16 Feb 2024 09:30:19 -0600 Subject: [PATCH 10/31] misc. fixes --- fortran/src/H5Ef.c | 2 +- fortran/src/H5Eff.F90 | 21 ++++++++++++++++++++- fortran/src/H5fortkit.F90 | 22 +++++++++++----------- 3 files changed, 32 insertions(+), 13 deletions(-) diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index f0f21cca973..6dd56ac058f 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -271,7 +271,7 @@ h5epush_c(hid_t_f *err_stack, hid_t_f *cls_id, hid_t_f *maj_id, hid_t_f *min_id, if (NULL == (c_msg = HD5f2cstring(msg, (size_t)*msg_len))) HGOTO_DONE(FAIL); - if (H5Epush2((hid_t)*err_stack, file, func, (uint)*line, (hid_t)*cls_id, (hid_t)*maj_id, (hid_t)*min_id, + if (H5Epush2((hid_t)*err_stack, file, 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 5bcb1c2289a..0556f7f8497 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -237,7 +237,26 @@ END SUBROUTINE h5eset_auto_f !! \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 arg[1-20] 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(). diff --git a/fortran/src/H5fortkit.F90 b/fortran/src/H5fortkit.F90 index 24af43d605c..70d7087d65e 100644 --- a/fortran/src/H5fortkit.F90 +++ b/fortran/src/H5fortkit.F90 @@ -34,8 +34,8 @@ MODULE H5fortkit ! HD5c2fstring ! INPUTS ! cstring - C string stored as a string array of size 'len' of string size LEN=1 -! flen - length of Fortran string -! clen - length of C array +! f_len - length of Fortran string +! c_len - length of C array ! OUTPUT ! fstring - Fortran string LEN=1 ! PURPOSE @@ -46,23 +46,23 @@ MODULE H5fortkit ! length greater than one, which is why we use the array of characters instead. ! ! SOURCE - SUBROUTINE HD5c2fstring(fstring,cstring,flen,clen) + SUBROUTINE HD5c2fstring(fstring,cstring,f_len,c_len) !***** IMPLICIT NONE INTEGER(SIZE_T) :: i - INTEGER(SIZE_T) :: flen - INTEGER(SIZE_T) :: clen + INTEGER(SIZE_T) :: f_len + INTEGER(SIZE_T) :: c_len CHARACTER(*) :: fstring - CHARACTER(LEN=1), DIMENSION(1:clen) :: cstring + CHARACTER(LEN=1), DIMENSION(1:c_len) :: cstring - INTEGER(SIZE_T) :: flen_max + INTEGER(SIZE_T) :: f_len_max fstring = '' - flen_max = LEN(fstring, KIND=SIZE_T) - DO i = 1, clen - IF (i .GT. flen_max) EXIT - IF (i .GT. flen) EXIT + f_len_max = LEN(fstring, KIND=SIZE_T) + DO i = 1, c_len + IF (i .GT. f_len_max) EXIT + IF (i .GT. f_len) EXIT IF (cstring(i)(1:1)==CHAR(0)) EXIT fstring(i:i) = cstring(i)(1:1) END DO From 9df38de47f67a684ecd5aa54fdb9be6fdf664323 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Fri, 16 Feb 2024 15:31:49 +0000 Subject: [PATCH 11/31] Committing clang-format changes --- fortran/src/H5Ef.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index 6dd56ac058f..1ff35e3d850 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -271,9 +271,9 @@ h5epush_c(hid_t_f *err_stack, hid_t_f *cls_id, hid_t_f *maj_id, hid_t_f *min_id, 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, (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) + if (H5Epush2((hid_t)*err_stack, file, 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); done: From daa96c2bc26034f1e002b0472059818a288de1a4 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 16 Feb 2024 10:52:38 -0600 Subject: [PATCH 12/31] added testing --- fortran/src/H5Ef.c | 29 ----------------------------- fortran/src/hdf5_fortrandll.def.in | 2 ++ 2 files changed, 2 insertions(+), 29 deletions(-) diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index 1ff35e3d850..2d3442716b3 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -20,35 +20,6 @@ #include "H5f90.h" #include "H5Eprivate.h" -/****if* H5Ef/h5eclear_c - * NAME - * h5eclear_c - * PURPOSE - * Call H5Eclear to clear the error stack for the current thread - * INPUTS - * - * OUTPUTS - * - * RETURNS - * 0 on success, -1 on failure - * SOURCE - */ -int_f -h5eclear_c(hid_t_f *estack_id) -/******/ -{ - int_f ret_value = 0; - - /* - * Call H5Eclear function. - */ - if (H5Eclear2((hid_t)*estack_id) < 0) - HGOTO_DONE(FAIL); - -done: - return ret_value; -} - /****if* H5Ef/h5eprint_c1 * NAME * h5eprint_c1 diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index 0bee95e8df1..2babf1b969a 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -114,6 +114,8 @@ H5E_mp_H5EREGISTER_CLASS_F H5E_mp_H5EUNREGISTER_CLASS_F H5E_mp_H5ECREATE_MSG_F H5E_mp_H5ECLOSE_MSG_F +H5E_mp_H5EGET_MSG_F +H5E_mp_H5EPUSH_F ; H5ES H5ES_mp_H5ESCREATE_F H5ES_mp_H5ESGET_COUNT_F From 6dcff85288c423b44041a3c133f1fbfe577525fe Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 16 Feb 2024 18:16:14 -0600 Subject: [PATCH 13/31] added more functions --- README.md | 4 +- fortran/src/H5Eff.F90 | 233 ++++++++++++++++++++++++++++- fortran/src/hdf5_fortrandll.def.in | 3 + fortran/test/tH5E_F03.F90 | 114 +++++++++++++- src/H5Epublic.h | 7 +- 5 files changed, 350 insertions(+), 11 deletions(-) diff --git a/README.md b/README.md index 9dd7b853553..f4bfa69e72c 100644 --- a/README.md +++ b/README.md @@ -16,8 +16,8 @@ HDF5 version 1.15.0 currently under development *Please refer to the release_docs/INSTALL file for installation instructions.* This repository contains a high-performance library's source code and a file format -specification that implement the HDF5® data model. The model has been adopted across -many industries and this implementation has become a de facto data management standard +specification that implements the HDF5® data model. The model has been adopted across +many industries, and this implementation has become a de facto data management standard in science, engineering, and research communities worldwide. The HDF Group is the developer, maintainer, and steward of HDF5 software. Find more diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 0556f7f8497..c0de18671fe 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -44,6 +44,17 @@ MODULE H5E INTEGER, PARAMETER :: PRINTON = 1 !< Turn on automatic printing of errors INTEGER, PARAMETER :: PRINTOFF = 0 !< Turn off automatic printing of errors +!> @brief h5e_error_t derived type + TYPE, BIND(C) :: h5e_error_t + INTEGER(HID_T) :: cls_id !< Class ID + INTEGER(HID_T) :: maj_num !< Major error ID + INTEGER(HID_T) :: min_num !< Minor error number + INTEGER(C_INT) :: line !< Line in file where error occurs + TYPE(C_PTR) :: func_name !< Function in which error occurred + TYPE(C_PTR) :: file_name !< File in which error occurred + TYPE(C_PTR) :: desc !< Optional supplied description + END TYPE h5e_error_t + CONTAINS !> @@ -125,6 +136,8 @@ END SUBROUTINE h5eprint_f !! \param namelen Number of characters in the name buffer. !! \param hdferr \fortran_error !! +!! \attention Deprecated: use H5Eget_msg_f() instead. +!! !! See C API: @ref H5Eget_major() !! SUBROUTINE h5eget_major_f(error_no, name, namelen, hdferr) @@ -154,6 +167,8 @@ END SUBROUTINE h5eget_major_f !! \param name Character string describing the error. !! \param hdferr \fortran_error !! +!! \attention Deprecated: use H5Eget_msg_f() instead. +!! !! See C API: @ref H5Eget_minor() !! SUBROUTINE h5eget_minor_f(error_no, name, hdferr) @@ -369,7 +384,19 @@ END FUNCTION h5epush_c arg16_def, arg17_def, arg18_def, arg19_def, arg20_def) END SUBROUTINE h5epush_f - +!> +!! \ingroup FH5E +!! +!! \brief Registers a client library or application program to the HDF5 error API. +!! +!! \param cls_name Name of the error class +!! \param lib_name Name of the client library or application to which the error class belongs +!! \param version Version of the client library or application to which the error class belongs. It can be NULL. +!! \param class_id Class identifier +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Eregister_class() +!! SUBROUTINE h5eregister_class_f(cls_name, lib_name, version, class_id, hdferr) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: cls_name @@ -404,7 +431,16 @@ END FUNCTION H5Eregister_class IF(class_id.LT.0) hdferr = -1 END SUBROUTINE h5eregister_class_f - +!> +!! \ingroup FH5E +!! +!! \brief Removes an error class. +!! +!! \param class_id Class identifier +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Eunregister_class() +!! SUBROUTINE h5eunregister_class_f(class_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: class_id @@ -421,7 +457,18 @@ END FUNCTION H5Eunregister_class hdferr = INT(H5Eunregister_class(class_id)) END SUBROUTINE h5eunregister_class_f - +!> +!! \ingroup FH5E +!! +!! \brief Adds a major or minor error message to an error class. +!! +!! \param class_id An error class identifier +!! \param msg_type The type of the error message +!! \param msg Major error message +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Ecreate_msg() +!! SUBROUTINE h5ecreate_msg_f(class_id, msg_type, msg, err_id, hdferr) IMPLICIT NONE @@ -453,7 +500,16 @@ END FUNCTION H5Ecreate_msg IF(err_id.LT.0) hdferr = -1 END SUBROUTINE h5ecreate_msg_f - +!> +!! \ingroup FH5E +!! +!! \brief Closes an error message. +!! +!! \param err_id An error message identifier +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Eclose_msg() +!! SUBROUTINE h5eclose_msg_f(err_id, hdferr) IMPLICIT NONE INTEGER(HID_T), INTENT(IN) :: err_id @@ -470,7 +526,25 @@ END FUNCTION H5Eclose_msg hdferr = INT(H5Eclose_msg(err_id)) END SUBROUTINE h5eclose_msg_f - +!> +!! \ingroup FH5E +!! +!! \brief Retrieves an error message. +!! +!! \param msg_id Error message identifier +!! \param msg_type The type of the error message. Valid values are H5E_MAJOR_F and H5E_MINOR_F. +!! \param msg Error message buffer +!! \param hdferr \fortran_error +!! \param msg_size The length of error message to be returned by this function +!! +!! If \p msg_size is omitted, the API will copy up to the length of \p msg, and it +!! is the application's responsibility to provide a large enough buffer. If \p msg_size +!! is zero, the required buffer size will be returned, and \p msg is not accessed. +!! If \p msg_size is greater than zero, the function will copy up to the length +!! of \p msg_size info \p msg. +!! +!! See C API: @ref H5Eget_msg() +!! SUBROUTINE H5Eget_msg_f(msg_id, msg_type, msg, hdferr, msg_size) IMPLICIT NONE @@ -539,6 +613,155 @@ END FUNCTION H5Eget_msg END SUBROUTINE H5Eget_msg_f +!> +!! \ingroup FH5E +!! +!! \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 +!! +!! See C API: @ref H5Eget_num() +!! + SUBROUTINE h5eget_num_f(error_stack_id, count, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: error_stack_id + INTEGER(SIZE_T), INTENT(OUT) :: count + INTEGER , INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(SIZE_T) FUNCTION H5Eget_num(error_stack_id) BIND(C, NAME='H5Eget_num') + IMPORT :: HID_T, SIZE_T + IMPLICIT NONE + INTEGER(HID_T), VALUE :: error_stack_id + END FUNCTION H5Eget_num + END INTERFACE + + count = H5Eget_num(error_stack_id) + + hdferr = 0 + IF(count.LT.0) hdferr = -1 + + END SUBROUTINE h5eget_num_f + +!> +!! \ingroup FH5E +!! +!! \brief Walks the specified error stack, calling the specified function. +!! +!! \param err_stack Error stack identifier +!! \param direction Direction in which the error stack is to be walked +!! \param op Function to be called for each error encountered +!! \param op_data Data to be passed to func +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Ewalk2() +!! + SUBROUTINE h5ewalk_f(err_stack, direction, op, op_data, hdferr) + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: err_stack + INTEGER , INTENT(IN) :: direction + TYPE(C_FUNPTR) , INTENT(IN) :: op + TYPE(C_PTR) , INTENT(INOUT) :: op_data ! Declare INOUT to bypass gfortran 4.8.5 issue + INTEGER , INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5Ewalk(err_stack, direction, op, op_data) & + BIND(C, NAME='H5Ewalk2') + IMPORT :: HID_T, C_FUNPTR, C_PTR, C_INT + IMPLICIT NONE + INTEGER(HID_T), VALUE :: err_stack + INTEGER(C_INT), VALUE :: direction + TYPE(C_FUNPTR), VALUE :: op + TYPE(C_PTR) , VALUE :: op_data + END FUNCTION H5Ewalk + END INTERFACE + + hdferr = INT(H5Ewalk(err_stack, direction, op, op_data)) + + END SUBROUTINE h5ewalk_f + +!> +!! \ingroup FH5E +!! +!! \brief Retrieves an error message. +!! +!! \param class_id Error class identifier +!! \param name Buffer for the error class name +!! \param hdferr \fortran_error +!! \param size The maximum number of characters of the class name to be returned by this function in \p name. +!! +!! If \p size is omitted, the API will copy up to the length of \p name, and it +!! is the application's responsibility to provide a large enough buffer. If \p size +!! is zero, the required buffer size will be returned, and \p name is not accessed. +!! If \p size is greater than zero, the function will copy up to the length +!! of \p size info \p name. +!! +!! See C API: @ref H5Eget_class_name() +!! + SUBROUTINE H5Eget_class_name_f(class_id, name, hdferr, size) + IMPLICIT NONE + + INTEGER(HID_T) , INTENT(IN) :: class_id + CHARACTER(LEN=*) :: name + INTEGER , INTENT(OUT) :: hdferr + INTEGER(SIZE_T) , INTENT(INOUT), OPTIONAL :: size + + CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(:), ALLOCATABLE, TARGET :: c_name + TYPE(C_PTR) :: f_ptr + INTEGER(SIZE_T) :: name_cp_sz + INTEGER(SIZE_T) :: c_size + + INTERFACE + INTEGER(SIZE_T) FUNCTION H5Eget_class_name(class_id, name, size) & + BIND(C,NAME='H5Eget_class_name') + IMPORT :: C_PTR + IMPORT :: HID_T, SIZE_T + IMPLICIT NONE + INTEGER(HID_T) , VALUE :: class_id + TYPE(C_PTR) , VALUE :: name + INTEGER(SIZE_T), VALUE :: size + END FUNCTION H5Eget_class_name + END INTERFACE + + hdferr = 0 + name_cp_sz = 0 + IF(PRESENT(size))THEN + IF(size .EQ. 0)THEN + c_size = H5Eget_class_name(class_id, C_NULL_PTR, 0_SIZE_T) + + IF(PRESENT(size)) size = c_size + IF(c_size.LT.0) hdferr = -1 + RETURN + ELSE + name_cp_sz = size + ENDIF + ENDIF + + IF(name_cp_sz.EQ.0) name_cp_sz = LEN(name) + + ALLOCATE(c_name(1:name_cp_sz+1), stat=hdferr) + IF (hdferr .NE. 0) THEN + hdferr = -1 + RETURN + ENDIF + f_ptr = C_LOC(c_name(1)(1:1)) + 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) + + DEALLOCATE(c_name) + + IF(PRESENT(size))THEN + size = c_size + ENDIF + + IF(c_size.LT.0) hdferr = -1 + + END SUBROUTINE H5Eget_class_name_f + + #if 0 !> !! \ingroup FH5E diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index 2babf1b969a..ad9cda339d2 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -116,6 +116,9 @@ H5E_mp_H5ECREATE_MSG_F H5E_mp_H5ECLOSE_MSG_F H5E_mp_H5EGET_MSG_F H5E_mp_H5EPUSH_F +H5E_mp_H5EGET_NUM_F +H5E_mp_H5EWALK_F +H5E_mp_H5EGET_CLASS_NAME_F ; H5ES H5ES_mp_H5ESCREATE_F H5ES_mp_H5ESGET_COUNT_F diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 733f2d3ce0c..9e3c1cc01bd 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -90,6 +90,105 @@ INTEGER FUNCTION my_hdf5_error_handler_nodata(estack_id, data_inout) bind(C) END FUNCTION my_hdf5_error_handler_nodata + !------------------------------------------------------------------------- + ! Function: custom_print_cb + ! + ! Purpose: Callback function to print error stack in customized way. + ! + !------------------------------------------------------------------------- + ! + INTEGER(C_INT) FUNCTION custom_print_cb(n, err_desc, op_data) BIND(C) + + ! This error function handle works with only version 2 error stack + + IMPLICIT NONE + + INTEGER(SIZE_T), PARAMETER :: MSG_SIZE = 64 + + INTEGER(C_INT) :: n + TYPE(h5e_error_t) :: err_desc + TYPE(C_PTR) :: op_data + + CHARACTER(LEN=MSG_SIZE) :: maj + CHARACTER(LEN=MSG_SIZE) :: min + CHARACTER(LEN=MSG_SIZE) :: cls + INTEGER :: indent = 4 + INTEGER(SIZE_T) :: size + INTEGER :: msg_type + + INTEGER :: error + + TYPE(C_PTR) :: f_ptr + + CALL H5Eget_class_name_f(err_desc%cls_id, cls, error) + IF(error .LT.0)THEN + custom_print_cb = -1 + RETURN + ENDIF + + IF(TRIM(cls).NE."Custom error class")THEN + custom_print_cb = -1 + RETURN + ENDIF + + size = 3 + CALL H5Eget_class_name_f(err_desc%cls_id, cls, error, size) + IF(error .LT.0)THEN + custom_print_cb = -1 + RETURN + ENDIF + IF(TRIM(cls).NE."Cus")THEN + custom_print_cb = -1 + RETURN + ENDIF + + size = 0 + CALL H5Eget_class_name_f(err_desc%cls_id, "", error, size) + IF(error .LT.0)THEN + custom_print_cb = -1 + RETURN + ENDIF + IF(size.NE.18)THEN + custom_print_cb = -1 + RETURN + ENDIF + + size = MSG_SIZE + CALL H5Eget_msg_f(err_desc%maj_num, msg_type, maj, error, size) + IF(error .LT.0)THEN + custom_print_cb = -1 + RETURN + ENDIF + + ! CALL h5eget_major_f(INT(err_desc%maj_num), maj, size, error) + + 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 MODULE TH5E_F03 @@ -207,7 +306,7 @@ SUBROUTINE test_error_stack(total_error) CHARACTER(LEN=18), TARGET :: file CHARACTER(LEN=18), TARGET :: func INTEGER , TARGET :: line - TYPE(C_PTR) :: ptr1, ptr2, ptr3 + TYPE(C_PTR) :: ptr1, ptr2, ptr3, ptr4 INTEGER :: msg_type CHARACTER(LEN=9) :: maj_mesg = "MAJOR MSG" @@ -216,6 +315,9 @@ SUBROUTINE test_error_stack(total_error) LOGICAL :: status CHARACTER(LEN=180) :: chr180 INTEGER :: idx + INTEGER(SIZE_T) :: count + CHARACTER(LEN=64), TARGET :: stderr + TYPE(C_FUNPTR) :: func_ptr #ifdef H5_FORTRAN_HAVE_CHAR_ALLOC CHARACTER(:), ALLOCATABLE :: msg_alloc @@ -247,6 +349,10 @@ SUBROUTINE test_error_stack(total_error) CALL check("H5Epush_f", error, total_error) + CALL h5eget_num_f(H5E_DEFAULT_F, count, error) + CALL check("h5eget_num_f", error, total_error) + CALL VERIFY("h5eget_num_f", count, 1_SIZE_T, total_error) + msg_size = 0 CALL H5Eget_msg_f(major, msg_type, chr9, error, msg_size) CALL check("H5Eget_msg_f", error, total_error) @@ -352,6 +458,12 @@ SUBROUTINE test_error_stack(total_error) CLOSE(12, STATUS='delete') ENDIF + stderr = "** Print error stack in customized way **"//C_NULL_CHAR + ptr4 = C_LOC(stderr(1:1)) + func_ptr = C_FUNLOC(custom_print_cb) + CALL h5ewalk_f(H5P_DEFAULT_F, H5E_WALK_UPWARD_F, func_ptr, ptr4, error) + CALL check("h5ewalk_f", error, total_error) + CALL H5Eclose_msg_f(major, error) CALL check("H5Eclose_msg_f", error, total_error) CALL H5Eclose_msg_f(minor, error) diff --git a/src/H5Epublic.h b/src/H5Epublic.h index 12713c0cc3d..9f5141372fb 100644 --- a/src/H5Epublic.h +++ b/src/H5Epublic.h @@ -250,7 +250,7 @@ H5_DLL herr_t H5Eclose_msg(hid_t err_id); * -------------------------------------------------------------------------- * \ingroup H5E * - * \brief Adds a major error message to an error class + * \brief Adds a major or minor error message to an error class * * \param[in] cls An error class identifier * \param[in] msg_type The type of the error message @@ -625,7 +625,7 @@ H5_DLL herr_t H5Eauto_is_v2(hid_t err_stack, unsigned *is_stack); * \brief Retrieves an error message * * \param[in] msg_id Error message identifier - * \param[out] type The type of the error message Valid values are #H5E_MAJOR + * \param[out] type The type of the error message. Valid values are #H5E_MAJOR * and #H5E_MINOR. * \param[out] msg Error message buffer * \param[in] size The length of error message to be returned by this function @@ -651,7 +651,8 @@ H5_DLL ssize_t H5Eget_msg(hid_t msg_id, H5E_type_t *type, char *msg, size_t size * \brief Retrieves the number of error messages in an error stack * * \estack_id{error_stack_id} - * \return Returns a non-negative value on success; otherwise returns a negative value. + * \return Returns number of error messages in an error stack on + * success; otherwise returns a negative value. * * \details H5Eget_num() retrieves the number of error records in the error * stack specified by \p error_stack_id (including major, minor From 92bc43cb22730261bc3f3b479dc7282e9bd3183b Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 16 Feb 2024 22:28:40 -0600 Subject: [PATCH 14/31] misc --- fortran/src/H5Eff.F90 | 3 ++- fortran/test/tH5E_F03.F90 | 14 +++++++------- src/H5Epublic.h | 2 +- 3 files changed, 10 insertions(+), 9 deletions(-) diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index c0de18671fe..1faa939a1da 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -464,7 +464,8 @@ END SUBROUTINE h5eunregister_class_f !! !! \param class_id An error class identifier !! \param msg_type The type of the error message -!! \param msg Major error message +!! \param msg Error message +!! \param err_id Error identifier !! \param hdferr \fortran_error !! !! See C API: @ref H5Ecreate_msg() diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 9e3c1cc01bd..2e44ff9cfdd 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -429,21 +429,21 @@ SUBROUTINE test_error_stack(total_error) READ(12,'(A)') chr180 idx = INDEX(string=chr180,substring="Custom error class") - IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + IF(idx.EQ.0) CALL check("h5eprint_f1", -1, total_error) idx = INDEX(string=chr180,substring="H5E_F03") - IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + IF(idx.EQ.0) CALL check("h5eprint_f2", -1, total_error) idx = INDEX(string=chr180,substring="0.1") - IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + IF(idx.EQ.0) CALL check("h5eprint_f3", -1, total_error) READ(12,'(A)') chr180 idx = INDEX(string=chr180,substring="FILE") - IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + IF(idx.EQ.0) CALL check("h5eprint_f4", -1, total_error) idx = INDEX(string=chr180,substring="99") - IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + IF(idx.EQ.0) CALL check("h5eprint_f5", -1, total_error) idx = INDEX(string=chr180,substring="FUNC") - IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + IF(idx.EQ.0) CALL check("h5eprint_f6", -1, total_error) idx = INDEX(string=chr180,substring="ERROR TEXT") - IF(idx.EQ.0) CALL check("h5eprint_f", -1, total_error) + IF(idx.EQ.0) CALL check("h5eprint_f7", -1, total_error) READ(12,'()') diff --git a/src/H5Epublic.h b/src/H5Epublic.h index 9f5141372fb..0d5993e84d4 100644 --- a/src/H5Epublic.h +++ b/src/H5Epublic.h @@ -254,7 +254,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 + * \param[in] msg Error message * \return An error ID (success), H5I_INVALID_HID (failure) * * \details H5Ecreate_msg() adds an error message to an error class defined by From 5705b339422bacc55560f552730c4d01c3c0d730 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 16 Feb 2024 23:03:57 -0600 Subject: [PATCH 15/31] misc2 --- fortran/src/H5Eff.F90 | 124 ++++++-------------------------------- fortran/test/tH5E_F03.F90 | 36 ++++++----- 2 files changed, 38 insertions(+), 122 deletions(-) diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 1faa939a1da..9605c84666c 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -126,6 +126,7 @@ END FUNCTION h5eprint_c2 hdferr = h5eprint_c2() ENDIF END SUBROUTINE h5eprint_f + !> !! \ingroup FH5E !! @@ -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 @@ -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 !> @@ -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() !! @@ -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 diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 2e44ff9cfdd..1eb195bd2f4 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -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 @@ -160,7 +160,26 @@ 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 @@ -168,25 +187,12 @@ 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 From 63a911580fc621218a15c105369555d145a3d06a Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 16 Feb 2024 23:40:39 -0600 Subject: [PATCH 16/31] misc3 --- fortran/src/H5Ef.c | 86 ------------------------------ fortran/src/H5Eff.F90 | 36 +++++++++++++ fortran/src/H5f90proto.h | 3 -- fortran/src/hdf5_fortrandll.def.in | 1 + 4 files changed, 37 insertions(+), 89 deletions(-) diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index 2d3442716b3..920c842c599 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -92,92 +92,6 @@ h5eprint_c2(void) return ret_value; } -/****if* H5Ef/h5eget_major_c - * NAME - * h5eget_major_c - * PURPOSE - * Get a character string describing an error specified by a - * major error number. - * INPUTS - * error_no - Major error number - * OUTPUTS - * name - character string describing the error - * RETURNS - * 0 on success, -1 on failure - * SOURCE - */ -int_f -h5eget_major_c(int_f *error_no, _fcd name, size_t_f *namelen) -/******/ -{ - char *c_name = NULL; - size_t c_namelen = (size_t)*namelen; - int_f ret_value = 0; - - if (c_namelen > 0) - c_name = (char *)malloc(c_namelen + 1); - - if (!c_name) - HGOTO_DONE(FAIL); - - /* - * Call H5Eget_msg function. - */ - H5Eget_msg((hid_t)*error_no, NULL, c_name, c_namelen); - HD5packFstring((char *)c_name, _fcdtocp(name), c_namelen); - if (!strcmp(c_name, "Invalid major error number")) - HGOTO_DONE(FAIL); - -done: - if (c_name) - free(c_name); - - return ret_value; -} - -/****if* H5Ef/h5eget_minor_c - * NAME - * h5eget_minor_c - * PURPOSE - * Get a character string describing an error specified by a - * minor error number. - * INPUTS - * error_no - Major error number - * OUTPUTS - * name - character string describing the error - * RETURNS - * 0 on success, -1 on failure - * SOURCE - */ -int_f -h5eget_minor_c(int_f *error_no, _fcd name, size_t_f *namelen) -/******/ -{ - char *c_name = NULL; - size_t c_namelen = (size_t)*namelen; - int_f ret_value = 0; - - if (c_namelen > 0) - c_name = (char *)malloc(c_namelen + 1); - - if (!c_name) - HGOTO_DONE(FAIL); - - /* - * Call H5Eget_msg function. - */ - H5Eget_msg((hid_t)*error_no, NULL, c_name, c_namelen); - HD5packFstring((char *)c_name, _fcdtocp(name), c_namelen); - if (!strcmp(c_name, "Invalid minor error number")) - HGOTO_DONE(FAIL); - -done: - if (c_name) - free(c_name); - - return ret_value; -} - /****if* H5Ef/h5eset_auto2_c * NAME * h5eset_auto2_c diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 9605c84666c..666dbe49779 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -34,6 +34,8 @@ ! 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 MODULE H5E @@ -750,5 +752,39 @@ END FUNCTION H5Eget_class_name END SUBROUTINE H5Eget_class_name_f +!> +!! \ingroup FH5E +!! +!! \brief Appends one error stack to another, optionally closing the source stack. +!! +!! \param dst_stack_id Error stack identifier +!! \param src_stack_id Error stack identifier +!! \param close_source_stack Flag to indicate whether to close the source stack +!! \param hdferr \fortran_error +!! +!! See C API: @ref H5Eappend_stack() +!! + SUBROUTINE H5Eappend_stack_f(dst_stack_id, src_stack_id, close_source_stack, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: dst_stack_id + INTEGER(HID_T), INTENT(IN) :: src_stack_id + LOGICAL , INTENT(IN) :: close_source_stack + INTEGER , INTENT(OUT) :: hdferr + + INTERFACE + INTEGER(C_INT) FUNCTION H5Eappend_stack(dst_stack_id, src_stack_id, close_source_stack) & + BIND(C, NAME='H5Eappend_stack') + IMPORT :: HID_T, C_BOOL, C_INT + IMPLICIT NONE + INTEGER(HID_T) , VALUE :: dst_stack_id + INTEGER(HID_T) , VALUE :: src_stack_id + LOGICAL(C_BOOL), VALUE :: close_source_stack + END FUNCTION H5Eappend_stack + END INTERFACE + + hdferr = INT(H5Eappend_stack(dst_stack_id, src_stack_id, LOGICAL(close_source_stack, C_BOOL))) + + END SUBROUTINE H5Eappend_stack_f + END MODULE H5E diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 6ad5a1af0dc..548c7cee7de 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -553,11 +553,8 @@ H5_FCDLL int_f h5iis_valid_c(hid_t_f *obj_id, int_f *c_valid); * Functions from H5Ef.c */ -H5_FCDLL int_f h5eclear_c(hid_t_f *estack_id); H5_FCDLL int_f h5eprint_c1(_fcd name, int_f *namelen); H5_FCDLL int_f h5eprint_c2(void); -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, const char *arg1, diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index ad9cda339d2..d38f9dd51e1 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -119,6 +119,7 @@ H5E_mp_H5EPUSH_F H5E_mp_H5EGET_NUM_F H5E_mp_H5EWALK_F H5E_mp_H5EGET_CLASS_NAME_F +H5E_mp_H5EAPPEND_STACK_F ; H5ES H5ES_mp_H5ESCREATE_F H5ES_mp_H5ESGET_COUNT_F From 3861b971c37b2e9b52187535f8dbf4d1224bb4da Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Tue, 20 Feb 2024 08:55:50 -0600 Subject: [PATCH 17/31] debugging --- fortran/src/H5Eff.F90 | 161 +++++++++++++++++++++++++++-- fortran/src/hdf5_fortrandll.def.in | 5 + fortran/test/tH5E_F03.F90 | 26 ++++- 3 files changed, 183 insertions(+), 9 deletions(-) diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 666dbe49779..e1c1ff1091b 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index d38f9dd51e1..8a58ca3529e 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -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 diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 1eb195bd2f4..387fec0bbb8 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -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 @@ -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) @@ -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 From d3c701f13a2676e2e81446dd8914df9051ad9ade Mon Sep 17 00:00:00 2001 From: "M. Scot Breitenfeld" Date: Tue, 20 Feb 2024 16:45:45 -0600 Subject: [PATCH 18/31] created new stack --- fortran/src/H5Eff.F90 | 13 ++++--------- fortran/test/tH5E_F03.F90 | 28 +++++++++++++++------------- 2 files changed, 19 insertions(+), 22 deletions(-) diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index e1c1ff1091b..9909013768e 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -710,7 +710,6 @@ INTEGER(SIZE_T) FUNCTION H5Eget_class_name(class_id, name, size) & 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 @@ -732,19 +731,15 @@ END FUNCTION H5Eget_class_name IF(name_cp_sz.EQ.0) name_cp_sz = LEN(name) - ALLOCATE(c_name(1:name_cp_sz+2), stat=hdferr) + ALLOCATE(c_name(1:name_cp_sz+1), stat=hdferr) IF (hdferr .NE. 0) THEN hdferr = -1 RETURN ENDIF 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) - !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 + c_size = H5Eget_class_name(class_id, f_ptr, name_cp_sz+1_SIZE_T) + + CALL HD5c2fstring(name, c_name, name_cp_sz, name_cp_sz+1_SIZE_T) DEALLOCATE(c_name) IF(PRESENT(size))THEN diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 387fec0bbb8..66938f24e2c 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -308,7 +308,7 @@ SUBROUTINE test_error_stack(total_error) INTEGER :: total_error INTEGER :: error - INTEGER(HID_T) :: cls_id, major, minor, estack_id1, estack_id2 + INTEGER(HID_T) :: cls_id, major, minor, estack_id, estack_id1, estack_id2 CHARACTER(LEN=18), TARGET :: file CHARACTER(LEN=18), TARGET :: func INTEGER , TARGET :: line @@ -348,14 +348,16 @@ SUBROUTINE test_error_stack(total_error) ptr2 = C_LOC(func) 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 default stack - CALL H5Epush_f(H5E_DEFAULT_F, cls_id, major, minor, "%s ERROR TEXT %s"//C_NEW_LINE, error, & + CALL H5Epush_f(estack_id, cls_id, major, minor, "%s ERROR TEXT %s"//C_NEW_LINE, error, & ptr1, ptr2, ptr3, & arg1=ACHAR(27)//"[31m", arg2=ACHAR(27)//"[0m" ) - CALL check("H5Epush_f", error, total_error) - CALL h5eget_num_f(H5E_DEFAULT_F, count, error) + CALL h5eget_num_f(estack_id, count, error) CALL check("h5eget_num_f", error, total_error) CALL VERIFY("h5eget_num_f", count, 1_SIZE_T, total_error) @@ -423,7 +425,7 @@ SUBROUTINE test_error_stack(total_error) OPEN(UNIT=12, FILE="H5Etest.txt", status='old') CLOSE(12, STATUS='delete') ENDIF - +#if 0 CALL h5eprint_f(error, "H5Etest.txt") CALL check("h5eprint_f", error, total_error) @@ -464,19 +466,17 @@ SUBROUTINE test_error_stack(total_error) CLOSE(12, STATUS='delete') ENDIF - +#endif 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 h5ewalk_f(estack_id, 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 + CALL h5eget_num_f(estack_id, count, error) + CALL check("h5eget_num_f", error, total_error) + CALL VERIFY("h5eget_num_f", count, 1_SIZE_T, total_error) ! Copy error stack, which clears the original CALL H5Eget_current_stack_f(estack_id1, error) @@ -484,7 +484,7 @@ SUBROUTINE test_error_stack(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 VERIFY("h5eget_num_f", count, 0_SIZE_T, total_error) CALL H5Eclose_msg_f(major, error) CALL check("H5Eclose_msg_f", error, total_error) @@ -501,6 +501,8 @@ SUBROUTINE test_error_stack(total_error) CALL H5Eclose_stack_f(estack_id2, error) CALL check(" H5Eclose_stack_f", error, total_error) + CALL H5Eclose_stack_f(estack_id, error) + CALL check("H5Eclose_stack_f", error, total_error) END SUBROUTINE test_error_stack From e6afa4712494d2f2d04a1449e497c32fadba33d7 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Thu, 22 Feb 2024 18:03:49 -0600 Subject: [PATCH 19/31] H5Eprint re-work --- configure.ac | 4 -- fortran/src/H5Ef.c | 51 +++++-------------- fortran/src/H5Eff.F90 | 80 +++++++++++++++++++++++------- fortran/src/H5f90proto.h | 3 +- fortran/src/hdf5_fortrandll.def.in | 3 +- fortran/test/tH5E_F03.F90 | 27 +++------- 6 files changed, 84 insertions(+), 84 deletions(-) diff --git a/configure.ac b/configure.ac index 0bee185c822..f2d48e56dec 100644 --- a/configure.ac +++ b/configure.ac @@ -655,10 +655,6 @@ if test "X$HDF_FORTRAN" = "Xyes"; then ## Checking if the compiler supports fortran character being allocatable PAC_HAVE_CHAR_ALLOC - if test "X$HAVE_CHAR_ALLOC_FORTRAN" = "Xno"; then - AC_MSG_ERROR([Fortran compiler lacks required Fortran 2003 features; unsupported Fortran 2003 compiler, remove --enable-fortran]) - fi - ## -------------------------------------------------------------------- ## Define wrappers for the C compiler to use Fortran function names ## diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index 920c842c599..4c929ee7b52 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -20,14 +20,15 @@ #include "H5f90.h" #include "H5Eprivate.h" -/****if* H5Ef/h5eprint_c1 +/****if* H5Ef/h5eprint_c * NAME - * h5eprint_c1 + * h5eprint_c * PURPOSE * Call H5Eprint to print the error stack in a default manner. * INPUTS - * name - file name - * namelen - length of name + * err_stack - error stack identifier + * name - file name + * namelen - length of name * OUTPUTS * * RETURNS @@ -35,23 +36,25 @@ * SOURCE */ int_f -h5eprint_c1(_fcd name, int_f *namelen) +h5eprint_c(hid_t_f *err_stack, _fcd name, size_t_f *namelen) /******/ { FILE *file = NULL; char *c_name = NULL; int_f ret_value = 0; - if (NULL == (c_name = (char *)HD5f2cstring(name, (size_t)*namelen))) + if( namelen ) { + if (NULL == (c_name = (char *)HD5f2cstring(name, (size_t)*namelen))) HGOTO_DONE(FAIL); - if (NULL == (file = fopen(c_name, "a"))) + if (NULL == (file = fopen(c_name, "a"))) HGOTO_DONE(FAIL); + } /* * Call H5Eprint2 function. */ - if (H5Eprint2(H5E_DEFAULT, file) < 0) - HGOTO_DONE(FAIL); + if (H5Eprint2((hid_t)*err_stack, file) < 0) + HGOTO_DONE(FAIL); done: if (file) @@ -62,36 +65,6 @@ h5eprint_c1(_fcd name, int_f *namelen) return ret_value; } -/****if* H5Ef/h5eprint_c2 - * NAME - * h5eprint_c2 - * PURPOSE - * Call H5Eprint to print the error stack to stderr - * in a default manner. - * INPUTS - * - * OUTPUTS - * - * RETURNS - * 0 on success, -1 on failure - * SOURCE - */ -int_f -h5eprint_c2(void) -/******/ -{ - int_f ret_value = 0; - - /* - * Call H5Eprint2 function. - */ - if (H5Eprint2(H5E_DEFAULT, NULL) < 0) - HGOTO_DONE(FAIL); - -done: - return ret_value; -} - /****if* H5Ef/h5eset_auto2_c * NAME * h5eset_auto2_c diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 9909013768e..307aa3dd16e 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -56,6 +56,21 @@ MODULE H5E TYPE(C_PTR) :: desc !< Optional supplied description END TYPE h5e_error_t + INTERFACE h5eprint_f + MODULE PROCEDURE h5eprint1_f + MODULE PROCEDURE h5eprint2_f + END INTERFACE h5eprint_f + + INTERFACE + INTEGER FUNCTION h5eprint_c(err_stack, name, namelen) BIND(C,NAME='h5eprint_c') + IMPORT :: C_CHAR, HID_T, C_PTR + IMPLICIT NONE + INTEGER(HID_T) :: err_stack + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name + TYPE(C_PTR), VALUE :: namelen + END FUNCTION h5eprint_c + END INTERFACE + CONTAINS !> @@ -88,6 +103,7 @@ END FUNCTION H5Eclear hdferr = INT(H5Eclear(estack_id_default)) END SUBROUTINE h5eclear_f +#ifdef H5_DOXYGEN !> !! \ingroup FH5E !! @@ -99,34 +115,62 @@ END SUBROUTINE h5eclear_f !! \note If \p name is not specified, the output will be sent to !! the standard error (stderr). !! -!! See C API: @ref H5Eprint2() +!! \attention Deprecated. +!! +!! See C API: @ref H5Eprint1() !! SUBROUTINE h5eprint_f(hdferr, name) CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name INTEGER, INTENT(OUT) :: hdferr - INTEGER :: namelen + END SUBROUTINE h5eprint_f - INTERFACE - INTEGER FUNCTION h5eprint_c1(name, namelen) BIND(C,NAME='h5eprint_c1') - IMPORT :: C_CHAR - IMPLICIT NONE - INTEGER :: namelen - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name - END FUNCTION h5eprint_c1 - END INTERFACE +!! \ingroup FH5E +!! +!! \brief Prints the error stack in a default manner. +!! +!! \param err_stack Error stack identifier +!! \param hdferr \fortran_error +!! \param name Name of the file that contains print output +!! +!! \note If \p name is not specified, the output will be sent to +!! the standard error (stderr). +!! +!! See C API: @ref H5Eprint2() +!! + SUBROUTINE h5eprint_f(err_stack, hdferr, name) + INTEGER(HID_T) , INTENT(IN) :: err_stack + INTEGER , INTENT(OUT) :: hdferr + CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name + END SUBROUTINE h5eprint_f - INTERFACE - INTEGER FUNCTION h5eprint_c2() BIND(C,NAME='h5eprint_c2') - END FUNCTION h5eprint_c2 - END INTERFACE +#else + + SUBROUTINE h5eprint1_f(hdferr, name) + CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name + INTEGER, INTENT(OUT) :: hdferr + + CALL h5eprint2_f(H5E_DEFAULT_F, hdferr, name) + + END SUBROUTINE h5eprint1_f + + SUBROUTINE h5eprint2_f(err_stack, hdferr, name) + INTEGER(HID_T), INTENT(IN) :: err_stack + CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name + INTEGER, INTENT(OUT) :: hdferr + + INTEGER(SIZE_T), TARGET :: namelen + TYPE(C_PTR) :: c_namelen IF (PRESENT(name)) THEN - namelen = LEN(NAME) - hdferr = h5eprint_c1(name, namelen) + namelen = LEN(NAME, SIZE_T) + c_namelen = C_LOC(namelen) + hdferr = h5eprint_c(err_stack, name, c_namelen) ELSE - hdferr = h5eprint_c2() + hdferr = h5eprint_c(err_stack, "", C_NULL_PTR) ENDIF - END SUBROUTINE h5eprint_f + END SUBROUTINE h5eprint2_f + +#endif !> !! \ingroup FH5E diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 548c7cee7de..a508c2f8095 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -553,8 +553,7 @@ H5_FCDLL int_f h5iis_valid_c(hid_t_f *obj_id, int_f *c_valid); * Functions from H5Ef.c */ -H5_FCDLL int_f h5eprint_c1(_fcd name, int_f *namelen); -H5_FCDLL int_f h5eprint_c2(void); +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, diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index 8a58ca3529e..56f54acbf75 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -106,7 +106,8 @@ H5D_mp_H5DWRITE_CHUNK_F H5D_mp_H5DREAD_CHUNK_F ; H5E H5E_mp_H5ECLEAR_F -H5E_mp_H5EPRINT_F +H5E_mp_H5EPRINT1_F +H5E_mp_H5EPRINT2_F H5E_mp_H5EGET_MAJOR_F H5E_mp_H5EGET_MINOR_F H5E_mp_H5ESET_AUTO_F diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 66938f24e2c..635bad638a3 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -99,8 +99,6 @@ END FUNCTION my_hdf5_error_handler_nodata ! INTEGER(C_INT) FUNCTION custom_print_cb(n, err_desc, op_data) BIND(C) - ! This error function handle works with only version 2 error stack - IMPLICIT NONE INTEGER(SIZE_T), PARAMETER :: MSG_SIZE = 64 @@ -112,14 +110,11 @@ INTEGER(C_INT) FUNCTION custom_print_cb(n, err_desc, op_data) BIND(C) CHARACTER(LEN=MSG_SIZE) :: maj CHARACTER(LEN=MSG_SIZE) :: minn CHARACTER(LEN=MSG_SIZE) :: cls - INTEGER :: indent = 4 INTEGER(SIZE_T) :: size INTEGER :: msg_type INTEGER :: error - TYPE(C_PTR) :: f_ptr - CALL H5Eget_class_name_f(err_desc%cls_id, cls, error) IF(error .LT.0)THEN custom_print_cb = -1 @@ -184,16 +179,6 @@ INTEGER(C_INT) FUNCTION custom_print_cb(n, err_desc, op_data) BIND(C) custom_print_cb = 0 END FUNCTION custom_print_cb -#if 0 - FILE *stream = (FILE *)client_data; - - 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); - -#endif END MODULE test_my_hdf5_error_handler @@ -351,7 +336,7 @@ SUBROUTINE test_error_stack(total_error) call h5ecreate_stack_f(estack_id, error) CALL check("h5ecreate_stack_f", error, total_error) - ! push a custom error message onto the default stack + ! push a custom error message onto the stack CALL H5Epush_f(estack_id, cls_id, major, minor, "%s ERROR TEXT %s"//C_NEW_LINE, error, & ptr1, ptr2, ptr3, & arg1=ACHAR(27)//"[31m", arg2=ACHAR(27)//"[0m" ) @@ -420,15 +405,17 @@ SUBROUTINE test_error_stack(total_error) CALL VERIFY("H5Eget_msg_f", msg_alloc, min_mesg, total_error) #endif + CALL h5eprint_f(H5E_DEFAULT_F, error) + CALL check("h5eprint_f", error, total_error) + INQUIRE(file="H5Etest.txt", EXIST=status) IF(status)THEN OPEN(UNIT=12, FILE="H5Etest.txt", status='old') CLOSE(12, STATUS='delete') ENDIF -#if 0 - CALL h5eprint_f(error, "H5Etest.txt") - CALL check("h5eprint_f", error, total_error) + CALL h5eprint_f(estack_id, error, "H5Etest.txt") + CALL check("h5eprint_f", error, total_error) INQUIRE(file="H5Etest.txt", EXIST=status) IF(.NOT.status)THEN @@ -466,7 +453,7 @@ SUBROUTINE test_error_stack(total_error) CLOSE(12, STATUS='delete') ENDIF -#endif + stderr = "** Print error stack in customized way **"//C_NULL_CHAR ptr4 = C_LOC(stderr(1:1)) func_ptr = C_FUNLOC(custom_print_cb) From 0ed3b616a83c59a1f1e111b3af51d1c34c438c83 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Fri, 23 Feb 2024 00:05:27 +0000 Subject: [PATCH 20/31] Committing clang-format changes --- fortran/src/H5Ef.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index 4c929ee7b52..bbcfb55c54b 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -43,18 +43,18 @@ h5eprint_c(hid_t_f *err_stack, _fcd name, size_t_f *namelen) char *c_name = NULL; int_f ret_value = 0; - if( namelen ) { - if (NULL == (c_name = (char *)HD5f2cstring(name, (size_t)*namelen))) - HGOTO_DONE(FAIL); - if (NULL == (file = fopen(c_name, "a"))) - HGOTO_DONE(FAIL); + if (namelen) { + if (NULL == (c_name = (char *)HD5f2cstring(name, (size_t)*namelen))) + HGOTO_DONE(FAIL); + if (NULL == (file = fopen(c_name, "a"))) + HGOTO_DONE(FAIL); } /* * Call H5Eprint2 function. */ if (H5Eprint2((hid_t)*err_stack, file) < 0) - HGOTO_DONE(FAIL); + HGOTO_DONE(FAIL); done: if (file) From 8672d311fa4239b2a1d4415fa861101f2197df34 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Thu, 22 Feb 2024 18:11:38 -0600 Subject: [PATCH 21/31] H5Eprint re-work --- fortran/test/tH5E_F03.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 635bad638a3..ad931976f32 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -407,6 +407,8 @@ SUBROUTINE test_error_stack(total_error) CALL h5eprint_f(H5E_DEFAULT_F, error) CALL check("h5eprint_f", error, total_error) + CALL h5eprint_f(error) + CALL check("h5eprint_f", error, total_error) INQUIRE(file="H5Etest.txt", EXIST=status) IF(status)THEN From aadb14ac368aa21e0ce6d7c3921796b31119e277 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Thu, 22 Feb 2024 20:33:46 -0600 Subject: [PATCH 22/31] H5Eprint re-work --- fortran/src/H5Eff.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 307aa3dd16e..81955880f63 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -166,7 +166,7 @@ SUBROUTINE h5eprint2_f(err_stack, hdferr, name) c_namelen = C_LOC(namelen) hdferr = h5eprint_c(err_stack, name, c_namelen) ELSE - hdferr = h5eprint_c(err_stack, "", C_NULL_PTR) + hdferr = h5eprint_c(err_stack, C_NULL_CHAR, C_NULL_PTR) ENDIF END SUBROUTINE h5eprint2_f From d0dbc9b908e590cbb1d260ea5d67fd0dce3524ce Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 23 Feb 2024 15:02:37 -0600 Subject: [PATCH 23/31] completed testing --- fortran/src/H5Eff.F90 | 2 +- fortran/test/tH5E_F03.F90 | 56 ++++++++++++++++++++++++++++++--------- 2 files changed, 45 insertions(+), 13 deletions(-) diff --git a/fortran/src/H5Eff.F90 b/fortran/src/H5Eff.F90 index 81955880f63..c519ddc9f83 100644 --- a/fortran/src/H5Eff.F90 +++ b/fortran/src/H5Eff.F90 @@ -66,7 +66,7 @@ INTEGER FUNCTION h5eprint_c(err_stack, name, namelen) BIND(C,NAME='h5eprint_c') IMPORT :: C_CHAR, HID_T, C_PTR IMPLICIT NONE INTEGER(HID_T) :: err_stack - CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name + CHARACTER(KIND=C_CHAR), DIMENSION(*) :: name TYPE(C_PTR), VALUE :: namelen END FUNCTION h5eprint_c END INTERFACE diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index ad931976f32..78066eaa56b 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -233,8 +233,7 @@ SUBROUTINE test_error(total_error) CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error) CALL verify("h5dcreate_f", error, -1, total_error) -!!$ CALL verify("H5Eset_auto_f",my_hdf5_error_handler_data(1),10, total_error) -!!$ CALL verify("H5Eset_auto_f",my_hdf5_error_handler_data(2),20, total_error) + CALL verify("H5Eset_auto_f",my_hdf5_error_handler_data, 990, total_error) !!$ ! Test enabling and disabling default printing !!$ @@ -333,7 +332,7 @@ SUBROUTINE test_error_stack(total_error) ptr2 = C_LOC(func) ptr3 = C_LOC(line) - call h5ecreate_stack_f(estack_id, error) + CALL h5ecreate_stack_f(estack_id, error) CALL check("h5ecreate_stack_f", error, total_error) ! push a custom error message onto the stack @@ -467,6 +466,16 @@ SUBROUTINE test_error_stack(total_error) CALL check("h5eget_num_f", error, total_error) CALL VERIFY("h5eget_num_f", count, 1_SIZE_T, total_error) + CALL H5Ecreate_stack_f(estack_id2, error) + CALL check("H5Ecreate_stack_f", error, total_error) + + CALL H5Eappend_stack_f(estack_id2, estack_id, .FALSE., error) + CALL check("H5Eappend_stack_f", error, total_error) + + CALL h5eget_num_f(estack_id2, count, error) + CALL check("h5eget_num_f", error, total_error) + CALL VERIFY("h5eget_num_f", count, 1_SIZE_T, total_error) + ! Copy error stack, which clears the original CALL H5Eget_current_stack_f(estack_id1, error) CALL check("H5Eget_current_stack_f", error, total_error) @@ -475,6 +484,38 @@ SUBROUTINE test_error_stack(total_error) CALL check("h5eget_num_f", error, total_error) CALL VERIFY("h5eget_num_f", count, 0_SIZE_T, total_error) + CALL H5Eclose_stack_f(estack_id2, error) + CALL check(" H5Eclose_stack_f", error, total_error) + + CALL H5Eclose_stack_f(estack_id, error) + CALL check("H5Eclose_stack_f", error, total_error) + + CALL H5Eclose_stack_f(estack_id1, error) + CALL check("H5Eclose_stack_f", error, total_error) + + CALL h5ecreate_stack_f(estack_id1, 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 check("H5Epush_f", error, total_error) + + CALL H5Eset_current_stack_f(estack_id1, error) ! API will also close estack_id1 + CALL check("H5Eset_current_stack_f", error, total_error) + + CALL h5eget_num_f(H5E_DEFAULT_F, count, error) + CALL check("h5eget_num_f", error, total_error) + CALL VERIFY("h5eget_num_f", count, 1_SIZE_T, total_error) + + CALL h5epop_f(H5E_DEFAULT_F, 1_size_t, total_error) + CALL check("h5epop_f", error, total_error) + + CALL h5eget_num_f(H5E_DEFAULT_F, count, error) + CALL check("h5eget_num_f", error, total_error) + CALL VERIFY("h5eget_num_f", count, 0_SIZE_T, total_error) + CALL H5Eclose_msg_f(major, error) CALL check("H5Eclose_msg_f", error, total_error) @@ -484,15 +525,6 @@ SUBROUTINE test_error_stack(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) - - CALL H5Eclose_stack_f(estack_id, error) - CALL check("H5Eclose_stack_f", error, total_error) - END SUBROUTINE test_error_stack END MODULE TH5E_F03 From 9627f9baa4cebd2901b7abf17dafda50d5be3bd7 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Mon, 26 Feb 2024 10:51:44 -0600 Subject: [PATCH 24/31] H5Eset_auto test --- fortran/src/H5Ef.c | 12 --- fortran/test/fortranlib_test_F03.F90 | 9 +- fortran/test/tH5E_F03.F90 | 128 +++++++++------------------ 3 files changed, 44 insertions(+), 105 deletions(-) diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index bbcfb55c54b..4c34472c88b 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -79,18 +79,6 @@ h5eprint_c(hid_t_f *err_stack, _fcd name, size_t_f *namelen) * 0 on success, -1 on failure * SOURCE */ -/* int_f */ -/* h5eset_auto2_c(hid_t_f *estack_id, H5E_auto2_t *func, void *client_data) */ -/* /\******\/ */ -/* { */ -/* int ret_val = -1; */ -/* herr_t status = -1; */ - -/* status = H5Eset_auto2((hid_t)*estack_id, *func, client_data); */ -/* if (status >= 0) ret_val = 0; */ -/* return ret_val; */ -/* } */ - int_f h5eset_auto2_c(int_f *printflag, hid_t_f *estack_id, H5E_auto2_t func, void *client_data) /******/ diff --git a/fortran/test/fortranlib_test_F03.F90 b/fortran/test/fortranlib_test_F03.F90 index 3527a0be987..1c38b36fb60 100644 --- a/fortran/test/fortranlib_test_F03.F90 +++ b/fortran/test/fortranlib_test_F03.F90 @@ -55,13 +55,12 @@ PROGRAM fortranlibtest_F03 total_error = total_error + 1 ENDIF - ret_total_error = 0 -! PROBLEMS with C -! CALL test_error(ret_total_error) -! CALL write_test_status(ret_total_error, ' Test error API based on data I/O', total_error) - WRITE(*,*) + ret_total_error = 0 + CALL test_error(ret_total_error) + CALL write_test_status(ret_total_error, ' Test error API based on data I/O', total_error) + ret_total_error = 0 CALL test_array_compound_atomic(ret_total_error) CALL write_test_status(ret_total_error, ' Testing 1-D Array of Compound Datatypes Functionality', total_error) diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 78066eaa56b..f5ed9fbc8c2 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -55,40 +55,26 @@ INTEGER FUNCTION my_hdf5_error_handler(estack_id, data_inout) bind(C) ! estack_id is always passed from C as: H5E_DEFAULT INTEGER(HID_T) :: estack_id - ! data that was registered with H5Eset_auto_f - INTEGER :: data_inout - - PRINT*, " " - PRINT*, " Subtest: H5Eset_auto_f custom error message with callback, WITH DATA" - PRINT*, " -This message should be written to standard out- " - PRINT*, " Data Values Passed In =", data_inout - PRINT*, " " - - data_inout = 10*data_inout - - my_hdf5_error_handler = 1 ! this is not used by the C routine - END FUNCTION my_hdf5_error_handler + ! data that was registered with H5Eset_auto_f + ! INTEGER :: data_inout ! another option + ! or + TYPE(C_PTR), VALUE :: data_inout - INTEGER FUNCTION my_hdf5_error_handler_nodata(estack_id, data_inout) bind(C) + INTEGER, POINTER :: iunit - ! This error function handle works with only version 2 error stack + CALL C_F_POINTER(data_inout, iunit) - IMPLICIT NONE + ! iunit = data_inout - ! estack_id is always passed from C as: H5E_DEFAULT - INTEGER(HID_T) :: estack_id - ! data that was registered with H5Eset_auto_f - TYPE(C_PTR) :: data_inout + WRITE(iunit,'(A)') "H5Eset_auto_f_msg" + WRITE(iunit,'(I0)') iunit - PRINT*, " " - PRINT*, " Subtest: H5Eset_auto_f custom error message with callback, NO DATA" - PRINT*, " -This message should be written to standard out- " - PRINT*, " " + iunit = 10*iunit - my_hdf5_error_handler_nodata = 1 ! this is not used by the C routine + my_hdf5_error_handler = 1 ! this is not used by the C routine - END FUNCTION my_hdf5_error_handler_nodata + END FUNCTION my_hdf5_error_handler !------------------------------------------------------------------------- ! Function: custom_print_cb @@ -193,30 +179,24 @@ SUBROUTINE test_error(total_error) IMPLICIT NONE - INTEGER(hid_t), PARAMETER :: FAKE_ID = -1 INTEGER :: total_error INTEGER(hid_t) :: file - INTEGER(hid_t) :: dataset, space - INTEGER(hsize_t), DIMENSION(1:2) :: dims INTEGER :: error - INTEGER, DIMENSION(:), POINTER :: ptr_data INTEGER, TARGET :: my_hdf5_error_handler_data + INTEGER, TARGET :: iunit TYPE(C_PTR) :: f_ptr TYPE(C_FUNPTR) :: func + CHARACTER(LEN=180) :: chr180 + INTEGER :: idx - TYPE(C_PTR), TARGET :: f_ptr1 + LOGICAL :: status - INTEGER, DIMENSION(1:1) :: array_shape + ! set the error stack to the customized routine - my_hdf5_error_handler_data = 99 - CALL h5fcreate_f("terror.h5", H5F_ACC_TRUNC_F, file, error) - CALL check("h5fcreate_f", error, total_error) + iunit = 12 + OPEN(iunit, FILE="stderr.txt") - ! Create the data space - dims(1) = 10 - dims(2) = 20 - CALL H5Screate_simple_f(2, dims, space, error) - CALL check("h5screate_simple_f", error, total_error) + my_hdf5_error_handler_data = iunit ! ** SET THE CUSTOMIZED PRINTING OF ERROR STACK ** @@ -226,63 +206,35 @@ SUBROUTINE test_error(total_error) ! set the data sent to the customized routine f_ptr = c_loc(my_hdf5_error_handler_data) - ! turn on automatic printing, and use a custom error routine with input data CALL H5Eset_auto_f(1, error, H5E_DEFAULT_F, func, f_ptr) + CALL check("H5Eset_auto_f", error, total_error) - ! Create the erring dataset - CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error) - CALL verify("h5dcreate_f", error, -1, total_error) - - CALL verify("H5Eset_auto_f",my_hdf5_error_handler_data, 990, total_error) - -!!$ ! Test enabling and disabling default printing -!!$ -!!$ CALL H5Eget_auto_f(H5E_DEFAULT_F, func1, f_ptr1, error) -!!$ CALL verify("H5Eget_auto_f", error, 0, total_error) - - ! PRINT*,c_associated(f_ptr1) - - ALLOCATE(ptr_data(1:2)) - ptr_data = 0 - array_shape(1) = 2 - CALL C_F_POINTER(f_ptr1, ptr_data, array_shape) - - ! ptr_data => f_ptr1(1) - - ! PRINT*,ptr_data(1) - -!!$ if(old_data != NULL) -!!$ TEST_ERROR; -!!$#ifdef H5_USE_16_API -!!$ if (old_func != (H5E_auto_t)H5Eprint) -!!$ TEST_ERROR; -!!$#else H5_USE_16_API -!!$ if (old_func != (H5E_auto2_t)H5Eprint2) -!!$ TEST_ERROR; -!!$#endif H5_USE_16_API + CALL h5fopen_f("DOESNOTEXIST", H5F_ACC_RDONLY_F, file, error) + CALL VERIFY("h5fopen_f", error, -1, total_error) + CLOSE(iunit) - ! set the customized error handling routine - func = c_funloc(my_hdf5_error_handler_nodata) - ! set the data sent to the customized routine as null - f_ptr = C_NULL_PTR - ! turn on automatic printing, and use a custom error routine with no input data - CALL H5Eset_auto_f(1, error, H5E_DEFAULT_F, func, f_ptr) - - CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error) - CALL verify("h5dcreate_f", error, -1, total_error) - + OPEN(iunit, FILE="stderr.txt") - ! turn on automatic printing with h5eprint_f which prints an error stack in the default manner. + READ(iunit,'(A)') chr180 + idx = INDEX(string=chr180,substring="H5Eset_auto_f_msg") + IF(idx.EQ.0) CALL check("H5Eset_auto_f", -1, total_error) + READ(iunit, *) idx + CALL VERIFY("H5Eset_auto_f", idx, iunit, total_error) + CALL VERIFY("H5Eset_auto_f", my_hdf5_error_handler_data, 10*iunit, total_error) - ! func = c_funloc(h5eprint_f) - ! CALL H5Eset_auto_f(0, error, H5E_DEFAULT_F, func, C_NULL_PTR) + CLOSE(iunit, STATUS='delete') CALL H5Eset_auto_f(0, error) - CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error) + CALL check("H5Eset_auto_f", error, total_error) - CALL H5Eset_auto_f(1, error) - CALL h5dcreate_f(FAKE_ID,"a_dataset",H5T_NATIVE_INTEGER, space, dataset, error) + CALL h5fopen_f("DOESNOTEXIST", H5F_ACC_RDONLY_F, file, error) + CALL VERIFY("h5fopen_f", error, -1, total_error) + + INQUIRE(file="H5Etest.txt", EXIST=status) + IF(status)THEN + CALL VERIFY("H5Eset_auto_f", error, -1, total_error) + ENDIF END SUBROUTINE test_error From 0233cba735df4ac0ffe53970a1a25cc7bf4b4d41 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Mon, 26 Feb 2024 10:58:50 -0600 Subject: [PATCH 25/31] updated Release notes --- release_docs/RELEASE.txt | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/release_docs/RELEASE.txt b/release_docs/RELEASE.txt index bc4ff92294f..a6ec1c5b9a2 100644 --- a/release_docs/RELEASE.txt +++ b/release_docs/RELEASE.txt @@ -388,6 +388,12 @@ New Features Fortran Library: ---------------- + - Added Fortran H5E APIs: + h5eregister_class_f, h5eunregister_class_f, h5ecreate_msg_f, h5eclose_msg_f + h5eget_msg_f, h5epush_f, h5eget_num_f, h5ewalk_f, h5eget_class_name_f, + h5eappend_stack_f, h5eget_current_stack_f, h5eset_current_stack_f, h5ecreate_stack_f, + h5eclose_stack_f, h5epop_f, h5eprint_f (C h5eprint v2 signature) + - Add API support for Fortran MPI_F08 module definitions: Adds support for MPI's MPI_F08 module datatypes: type(MPI_COMM) and type(MPI_INFO) for HDF5 APIs: H5PSET_FAPL_MPIO_F, H5PGET_FAPL_MPIO_F, H5PSET_MPI_PARAMS_F, H5PGET_MPI_PARAMS_F From dd02654093d1dc1f26cdeca528f02eb0640f77e8 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Mon, 26 Feb 2024 11:02:09 -0600 Subject: [PATCH 26/31] revert --- configure.ac | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 30b710bdc93..bb75019f3a8 100644 --- a/configure.ac +++ b/configure.ac @@ -13,7 +13,7 @@ ## ---------------------------------------------------------------------- ## Initialize configure. ## -AC_PREREQ([2.69]) +AC_PREREQ([2.71]) ## AC_INIT takes the name of the package, the version number, and an ## email address to report bugs. AC_CONFIG_SRCDIR takes a unique file From c8000731d6afbbb7fa69367aecd0e2cf3f8a9372 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Mon, 26 Feb 2024 12:03:04 -0600 Subject: [PATCH 27/31] corrected const --- fortran/src/H5Ef.c | 8 ++++---- fortran/src/H5f90proto.h | 11 +++++------ 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index 4c34472c88b..86f7bea15d1 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -100,10 +100,10 @@ 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, 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) + 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) /******/ { diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index a508c2f8095..739d81c7c63 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -555,12 +555,11 @@ 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, 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); +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); /* * Functions from H5f.c From 74f258ce22f65c2971bb58513bcf7ee24921e18e Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Mon, 26 Feb 2024 18:04:32 +0000 Subject: [PATCH 28/31] Committing clang-format changes --- fortran/src/H5Ef.c | 9 +++++---- fortran/src/H5f90proto.h | 12 +++++++----- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c index 86f7bea15d1..449c8fa1b27 100644 --- a/fortran/src/H5Ef.c +++ b/fortran/src/H5Ef.c @@ -100,10 +100,11 @@ 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) + 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) /******/ { diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 739d81c7c63..4bc8c2fa21d 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -555,11 +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, 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); /* * Functions from H5f.c From 3720bf7f2b41179dae06a49b631c9a3c2761e79a Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Mon, 26 Feb 2024 12:05:13 -0600 Subject: [PATCH 29/31] space clean-up --- fortran/test/tH5F.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/fortran/test/tH5F.F90 b/fortran/test/tH5F.F90 index 776959680de..569d4598c92 100644 --- a/fortran/test/tH5F.F90 +++ b/fortran/test/tH5F.F90 @@ -1036,7 +1036,6 @@ SUBROUTINE file_close(cleanup, total_error) total_error=total_error + 1 endif CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid2, error, access_prp=fapl2) - if( error .ne. -1) then total_error = total_error + 1 write(*,*) " Open with H5F_CLOSE_SEMI should fail " From 91eb08df27b11a8dd404b212eba0dcfe48e47f0b Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Mon, 26 Feb 2024 15:12:07 -0600 Subject: [PATCH 30/31] updated release notes --- release_docs/RELEASE.txt | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/release_docs/RELEASE.txt b/release_docs/RELEASE.txt index 604f86d5324..cb7701ebbf6 100644 --- a/release_docs/RELEASE.txt +++ b/release_docs/RELEASE.txt @@ -1146,7 +1146,11 @@ Bug Fixes since HDF5-1.14.0 release Fortran API ----------- - - + - Fixed: HDF5 fails to compile with -Werror=lto-type-mismatch + + Removed the use of the offending C stub wrapper. + + Fixes GitHub issue #3987 High-Level Library From 934b271339b48e3fad6f22f8ccf1a98e90df8a7b Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Wed, 6 Mar 2024 11:17:37 -0600 Subject: [PATCH 31/31] updated Release notes --- release_docs/RELEASE.txt | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/release_docs/RELEASE.txt b/release_docs/RELEASE.txt index cb7701ebbf6..3946eacd5dc 100644 --- a/release_docs/RELEASE.txt +++ b/release_docs/RELEASE.txt @@ -394,7 +394,7 @@ New Features h5eappend_stack_f, h5eget_current_stack_f, h5eset_current_stack_f, h5ecreate_stack_f, h5eclose_stack_f, h5epop_f, h5eprint_f (C h5eprint v2 signature) - - Add API support for Fortran MPI_F08 module definitions: + - Added API support for Fortran MPI_F08 module definitions: Adds support for MPI's MPI_F08 module datatypes: type(MPI_COMM) and type(MPI_INFO) for HDF5 APIs: H5PSET_FAPL_MPIO_F, H5PGET_FAPL_MPIO_F, H5PSET_MPI_PARAMS_F, H5PGET_MPI_PARAMS_F Ref. #3951 @@ -1387,6 +1387,10 @@ Known Problems The subsetting option in ph5diff currently will fail and should be avoided. The subsetting option works correctly in serial h5diff. + Flang Fortran compilation will fail (last check version 17) due to not yet + implemented: (1) derived type argument passed by value (H5VLff.F90), + and (2) support for REAL with KIND = 2 in intrinsic SPACING used in testing. + Several tests currently fail on certain platforms: MPI_TEST-t_bigio fails with spectrum-mpi on ppc64le platforms.