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)