H5Eprint re-work

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
   ##

fortran/src/H5Ef.c

@@ -20,38 +20,41 @@
 #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
  *  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)))
+    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

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

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,

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

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)