Added new H5E with tests. (#4049)

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)

Addresses Issue #3987

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

config/cmake/H5pubconf.h.in

@@ -68,6 +68,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@
 

config/cmake/HDF5UseFortran.cmake

@@ -124,6 +124,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
 #-----------------------------------------------------------------------------

config/cmake/HDFUseFortran.cmake

@@ -78,6 +78,13 @@ set (STORAGE_SIZE_CODE
        END PROGRAM
   "
 )
+set (CHAR_ALLOC
+  "
+       PROGRAM main
+         CHARACTER(:), ALLOCATABLE :: str
+       END PROGRAM
+  "
+)
 set (ISO_FORTRAN_ENV_CODE
   "
        PROGRAM main
@@ -132,6 +139,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)

configure.ac

@@ -652,6 +652,8 @@ 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
 
   ## --------------------------------------------------------------------
   ## Define wrappers for the C compiler to use Fortran function names
@@ -741,6 +743,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
 

doxygen/examples/H5E_examples.c

@@ -6,6 +6,9 @@
 #include <stdio.h>
 #include <stdlib.h>
 
+#define RESET "\x1b[0m"
+#define RED   "\x1b[31m"
+
 int
 main(void)
 {
@@ -34,8 +37,8 @@ main(void)
         }
 
         // push a custom error message onto the default stack
-        if (H5Epush2(H5E_DEFAULT, __FILE__, __FUNCTION__, __LINE__, cls, major, minor, "Hello, Error!\n") <
-            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;
         }

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)
 

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

fortran/src/H5Ef.c

@@ -20,66 +20,40 @@
 #include "H5f90.h"
 #include "H5Eprivate.h"
 
-/****if* H5Ef/h5eclear_c
+/****if* H5Ef/h5eprint_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
+ *  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
  *  0 on success, -1 on failure
  * 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)))
-        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(H5E_DEFAULT, file) < 0)
+    if (H5Eprint2((hid_t)*err_stack, file) < 0)
         HGOTO_DONE(FAIL);
 
 done:
@@ -91,122 +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/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
@@ -221,18 +79,6 @@ h5eget_minor_c(int_f *error_no, _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)
 /******/
@@ -251,3 +97,34 @@ 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, const char *arg1, const char *arg2, const char *arg3,
+          const char *arg4, const char *arg5, const char *arg6, const char *arg7, const char *arg8,
+          const char *arg9, const char *arg10, const char *arg11, const char *arg12, const char *arg13,
+          const char *arg14, const char *arg15, const char *arg16, const char *arg17, const char *arg18,
+          const char *arg19, const char *arg20)
+/******/
+{
+
+    char *c_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, (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:
+    if (c_msg)
+        free(c_msg);
+    return ret_value;
+}