fixed H5Eget_minor

brtnfld · Feb 9, 2024 · e475b0f · e475b0f
1 parent eab3e07
commit e475b0f
Show file tree

Hide file tree

Showing 7 changed files with 139 additions and 26 deletions.
diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c
@@ -254,17 +254,19 @@ 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)
 /******/
 {
 
     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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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