diff options
| -rw-r--r-- | fortran/src/CMakeLists.txt | 4 | ||||
| -rw-r--r-- | fortran/src/H5Pf.c | 42 | ||||
| -rw-r--r-- | fortran/src/H5Tf.c | 35 | ||||
| -rw-r--r-- | fortran/src/H5Tff.f90 | 71 | ||||
| -rw-r--r-- | fortran/src/Makefile.in | 4 | ||||
| -rw-r--r-- | fortran/test/tH5L_F03.f90 | 2 | ||||
| -rw-r--r-- | fortran/test/tH5O_F03.f90 | 2 | ||||
| -rw-r--r-- | fortran/test/tH5P_F03.f90 | 52 |
8 files changed, 120 insertions, 92 deletions
diff --git a/fortran/src/CMakeLists.txt b/fortran/src/CMakeLists.txt index 66f6634..a4407e5 100644 --- a/fortran/src/CMakeLists.txt +++ b/fortran/src/CMakeLists.txt @@ -156,10 +156,10 @@ set_target_properties (${HDF5_F90_C_LIB_TARGET} PROPERTIES # Fortran 2003 standard #----------------------------------------------------------------------------- if (HDF5_ENABLE_F2003) - # default real is 4 bytes, so include double signatures + # F2003 features are enabled set (F_STATUS "_F03") else (HDF5_ENABLE_F2003) - # default real is 8 bytes, so exclude double signatures + # F2003 features are not enabled set (F_STATUS "_F90") endif (HDF5_ENABLE_F2003) diff --git a/fortran/src/H5Pf.c b/fortran/src/H5Pf.c index cd354c7..b66709a 100644 --- a/fortran/src/H5Pf.c +++ b/fortran/src/H5Pf.c @@ -483,19 +483,21 @@ nh5pset_fill_value_double_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue) /****if* H5Pf/h5pget_fill_valuec_c * NAME - * h5pget_fill_valuec_c + * h5pget_fill_valuec_c * PURPOSE - * Call h5pget_fill_value_c to a character fill value + * Call h5pget_fill_value_c to a character fill value * INPUTS - * prp_id - property list identifier - * type_id - datatype identifier (fill value is of type type_id) - * fillvalue - character value + * prp_id - property list identifier + * type_id - datatype identifier (fill value is of type type_id) + * fillvalue - character value * RETURNS - * 0 on success, -1 on failure - * Saturday, August 14, 1999 + * 0 on success, -1 on failure * AUTHOR * Elena Pourmal + * Saturday, August 14, 1999 * HISTORY + * Fixed wrong call to C wrapper, was nh5pset_fill_value_c, changed + * to nh5pget_fill_value_c. MSB - 7/21/2014 * * SOURCE */ @@ -506,27 +508,27 @@ nh5pget_fill_valuec_c (hid_t_f *prp_id, hid_t_f *type_id, _fcd fillvalue) int ret_value = -1; /* - * Call h5pget_fill_value_c function. + * Call h5pget_fill_value_c function. */ - ret_value = nh5pset_fill_value_c(prp_id, type_id, _fcdtocp(fillvalue)); + ret_value = nh5pget_fill_value_c(prp_id, type_id, _fcdtocp(fillvalue)); return ret_value; } /****if* H5Pf/h5pget_fill_value_c * NAME - * h5pget_fill_value_c + * h5pget_fill_value_c * PURPOSE - * Call H5Pget_fill_value to set a fillvalue for a dataset + * Call H5Pget_fill_value to set a fillvalue for a dataset * INPUTS - * prp_id - property list identifier - * type_id - datatype identifier (fill value is of type type_id) - * fillvalue - fillvalue + * prp_id - property list identifier + * type_id - datatype identifier (fill value is of type type_id) + * fillvalue - fillvalue * RETURNS - * 0 on success, -1 on failure + * 0 on success, -1 on failure * AUTHOR * Elena Pourmal - * Saturday, August 14, 1999 + * Saturday, August 14, 1999 * SOURCE */ int_f @@ -542,7 +544,7 @@ nh5pget_fill_value_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue) * Call H5Pget_fill_value function. */ c_prp_id = (hid_t)*prp_id; - c_type_id = (int)*type_id; + c_type_id = (hid_t)*type_id; ret = H5Pget_fill_value(c_prp_id, c_type_id, fillvalue); if (ret < 0) return ret_value; @@ -556,7 +558,7 @@ nh5pget_fill_value_integer_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue /* * Call h5pget_fill_value_c function. */ - return nh5pset_fill_value_c(prp_id, type_id, fillvalue); + return nh5pget_fill_value_c(prp_id, type_id, fillvalue); } int_f @@ -565,7 +567,7 @@ nh5pget_fill_value_real_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue) /* * Call h5pget_fill_value_c function. */ - return nh5pset_fill_value_c(prp_id, type_id, fillvalue); + return nh5pget_fill_value_c(prp_id, type_id, fillvalue); } int_f @@ -574,7 +576,7 @@ nh5pget_fill_value_double_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue) /* * Call h5pget_fill_value_c function. */ - return nh5pset_fill_value_c(prp_id, type_id, fillvalue); + return nh5pget_fill_value_c(prp_id, type_id, fillvalue); } /****if* H5Pf/h5pget_version_c diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c index df581ee..32cdb72 100644 --- a/fortran/src/H5Tf.c +++ b/fortran/src/H5Tf.c @@ -225,31 +225,32 @@ nh5tequal_c ( hid_t_f *type1_id , hid_t_f *type2_id, int_f *c_flag) return ret_value; } - /****if* H5Tf/h5tget_class_c * NAME - * h5tget_class_c + * h5tget_class_c * PURPOSE - * Call H5Tget_class to determine the datatype class + * Call H5Tget_class to determine the datatype class * INPUTS - * type_id - identifier of the dataspace + * type_id - identifier of the dataspace * OUTPUTS - * classtype - class type; possible values are: - * H5T_NO_CLASS_F (-1) - * H5T_INTEGER_F (0) - * H5T_FLOAT_F (1) - * H5T_TIME_F (2) - * H5T_STRING_F (3) - * H5T_BITFIELD_F (4) - * H5T_OPAQUE_F (5) - * H5T_COMPOUNDF (6) - * H5T_REFERENCE_F (7) - * H5T_ENUMF (8) + * classtype - class type; possible values are: + * H5T_NO_CLASS_F (-1) + * H5T_INTEGER_F (0) + * H5T_FLOAT_F (1) + * H5T_TIME_F (2) + * H5T_STRING_F (3) + * H5T_BITFIELD_F (4) + * H5T_OPAQUE_F (5) + * H5T_COMPOUNDF (6) + * H5T_REFERENCE_F (7) + * H5T_ENUM_F (8) + * H5T_VLEN_F (9) + * H5T_ARRAY_F (10) * RETURNS - * 0 on success, -1 on failure + * 0 on success, -1 on failure * AUTHOR * Elena Pourmal - * Saturday, August 14, 1999 + * Saturday, August 14, 1999 * HISTORY * * SOURCE diff --git a/fortran/src/H5Tff.f90 b/fortran/src/H5Tff.f90 index 89bd972..0e1dbb0 100644 --- a/fortran/src/H5Tff.f90 +++ b/fortran/src/H5Tff.f90 @@ -335,20 +335,22 @@ CONTAINS ! Returns the datatype class identifier. ! ! INPUTS -! type_id - datatype identifier +! type_id - Datatype identifier ! OUTPUTS -! class - class, possible values are: -! H5T_NO_CLASS_F (-1) -! H5T_INTEGER_F (0) -! H5T_FLOAT_F (1) -! H5T_TIME_F (2) -! H5T_STRING_F (3) -! H5T_BITFIELD_F (4) -! H5T_OPAQUE_F (5) -! H5T_COMPOUND_F (6) -! H5T_REFERENCE_F (7) -! H5T_ENUM_F (8) -! hdferr - Returns 0 if successful and -1 if fails +! class - Class, possible values are: +! H5T_NO_CLASS_F (-1) +! H5T_INTEGER_F (0) +! H5T_FLOAT_F (1) +! H5T_TIME_F (2) +! H5T_STRING_F (3) +! H5T_BITFIELD_F (4) +! H5T_OPAQUE_F (5) +! H5T_COMPOUND_F (6) +! H5T_REFERENCE_F (7) +! H5T_ENUM_F (8) +! H5T_VLEN_F (9) +! H5T_ARRAY_F (10) +! hdferr - Returns 0 if successful and -1 if fails ! ! AUTHOR ! Elena Pourmal @@ -361,35 +363,24 @@ CONTAINS ! ! SOURCE SUBROUTINE h5tget_class_f(type_id, class, hdferr) - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier - INTEGER, INTENT(OUT) :: class - ! Datatype class, possible values are: - ! H5T_NO_CLASS_F (-1) - ! H5T_INTEGER_F (0) - ! H5T_FLOAT_F (1) - ! H5T_TIME_F (2) - ! H5T_STRING_F (3) - ! H5T_BITFIELD_F (4) - ! H5T_OPAQUE_F (5) - ! H5T_COMPOUND_F (6) - ! H5T_REFERENCE_F (7) - ! H5T_ENUM_F (8) - INTEGER, INTENT(OUT) :: hdferr ! Error code + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER, INTENT(OUT) :: class + INTEGER, INTENT(OUT) :: hdferr !***** - INTERFACE - INTEGER FUNCTION h5tget_class_c(type_id, class) - USE H5GLOBAL - !DEC$IF DEFINED(HDF5F90_WINDOWS) - !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TGET_CLASS_C'::h5tget_class_c - !DEC$ENDIF - INTEGER(HID_T), INTENT(IN) :: type_id - INTEGER, INTENT(OUT) :: class - END FUNCTION h5tget_class_c - END INTERFACE + INTERFACE + INTEGER FUNCTION h5tget_class_c(type_id, class) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TGET_CLASS_C'::h5tget_class_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: type_id + INTEGER, INTENT(OUT) :: class + END FUNCTION h5tget_class_c + END INTERFACE - hdferr = h5tget_class_c(type_id, class) - END SUBROUTINE h5tget_class_f + hdferr = h5tget_class_c(type_id, class) + END SUBROUTINE h5tget_class_f ! !****s* H5T/h5tget_size_f ! diff --git a/fortran/src/Makefile.in b/fortran/src/Makefile.in index d74793d..a38b5ac 100644 --- a/fortran/src/Makefile.in +++ b/fortran/src/Makefile.in @@ -731,8 +731,8 @@ CHECK_CLEANFILES = *.chkexe *.chklog *.clog # Add libtool shared library version numbers to the HDF5 library # See libtool versioning documentation online. -LT_VERS_INTERFACE = 8 -LT_VERS_REVISION = 3 +LT_VERS_INTERFACE = 6 +LT_VERS_REVISION = 188 LT_VERS_AGE = 0 AM_FCLIBS = $(LIBHDF5) diff --git a/fortran/test/tH5L_F03.f90 b/fortran/test/tH5L_F03.f90 index 8cc17fb..795f1e2 100644 --- a/fortran/test/tH5L_F03.f90 +++ b/fortran/test/tH5L_F03.f90 @@ -58,7 +58,7 @@ CONTAINS !** !*************************************************************** - INTEGER FUNCTION liter_cb(group, name, link_info, op_data) bind(C) + INTEGER(KIND=C_INT) FUNCTION liter_cb(group, name, link_info, op_data) bind(C) USE HDF5 USE ISO_C_BINDING diff --git a/fortran/test/tH5O_F03.f90 b/fortran/test/tH5O_F03.f90 index 598e83e..b7003b3 100644 --- a/fortran/test/tH5O_F03.f90 +++ b/fortran/test/tH5O_F03.f90 @@ -68,7 +68,7 @@ CONTAINS IMPLICIT NONE - INTEGER(HID_T) :: group_id + INTEGER(HID_T), VALUE :: group_id CHARACTER(LEN=1), DIMENSION(1:180) :: name TYPE(h5o_info_t) :: oinfo TYPE(ovisit_ud_t) :: op_data diff --git a/fortran/test/tH5P_F03.f90 b/fortran/test/tH5P_F03.f90 index 91d9e3a..945d0a5 100644 --- a/fortran/test/tH5P_F03.f90 +++ b/fortran/test/tH5P_F03.f90 @@ -43,7 +43,7 @@ MODULE test_genprop_cls_cb1_mod USE ISO_C_BINDING IMPLICIT NONE - TYPE, bind(C) :: cop_cb_struct_ ! /* Struct for iterations */ + TYPE, BIND(C) :: cop_cb_struct_ ! /* Struct for iterations */ INTEGER :: count INTEGER(HID_T) :: id END TYPE cop_cb_struct_ @@ -59,10 +59,10 @@ CONTAINS INTEGER(HID_T), INTENT(IN), VALUE :: list_id TYPE(cop_cb_struct_) :: create_data - + create_data%count = create_data%count + 1 create_data%id = list_id - + test_genprop_cls_cb1_f = 0 END FUNCTION test_genprop_cls_cb1_f @@ -111,6 +111,10 @@ SUBROUTINE test_create(total_error) INTEGER(SIZE_T) :: h5off TYPE(C_PTR) :: f_ptr LOGICAL :: differ1, differ2 + CHARACTER(LEN=1) :: cfill + INTEGER :: ifill + REAL :: rfill + REAL(KIND=dp) :: dpfill !/* ! * Create a file. @@ -162,6 +166,41 @@ SUBROUTINE test_create(total_error) f_ptr = C_LOC(fill_ctype) + ! Test various fill values + CALL H5Pset_fill_value_f(dcpl, H5T_NATIVE_CHARACTER, 'X', error) + CALL check("H5Pset_fill_value_f",error, total_error) + CALL h5pget_fill_value_f(dcpl, H5T_NATIVE_CHARACTER, cfill, error) + CALL check("H5Pget_fill_value_f",error, total_error) + IF(cfill.NE.'X')THEN + PRINT*,"***ERROR: Returned wrong fill value (character)" + total_error = total_error + 1 + ENDIF + CALL H5Pset_fill_value_f(dcpl, H5T_NATIVE_INTEGER, 9, error) + CALL check("H5Pset_fill_value_f",error, total_error) + CALL h5pget_fill_value_f(dcpl, H5T_NATIVE_INTEGER, ifill, error) + CALL check("H5Pget_fill_value_f",error, total_error) + IF(ifill.NE.9)THEN + PRINT*,"***ERROR: Returned wrong fill value (integer)" + total_error = total_error + 1 + ENDIF + CALL H5Pset_fill_value_f(dcpl, H5T_NATIVE_DOUBLE, 1.0_dp, error) + CALL check("H5Pset_fill_value_f",error, total_error) + CALL h5pget_fill_value_f(dcpl, H5T_NATIVE_DOUBLE, dpfill, error) + CALL check("H5Pget_fill_value_f",error, total_error) + IF(.NOT.dreal_eq( REAL(dpfill,dp), 1.0_dp))THEN + PRINT*,"***ERROR: Returned wrong fill value (double)" + total_error = total_error + 1 + ENDIF + CALL H5Pset_fill_value_f(dcpl, H5T_NATIVE_REAL, 2.0, error) + CALL check("H5Pset_fill_value_f",error, total_error) + CALL h5pget_fill_value_f(dcpl, H5T_NATIVE_REAL, rfill, error) + CALL check("H5Pget_fill_value_f",error, total_error) + IF(.NOT.dreal_eq( REAL(rfill,dp), REAL(2.0,dp)))THEN + PRINT*,"***ERROR: Returned wrong fill value (real)" + total_error = total_error + 1 + ENDIF + + ! For the actual compound type CALL H5Pset_fill_value_f(dcpl, comp_type_id, f_ptr, error) CALL check("H5Pget_fill_value_f",error, total_error) @@ -243,12 +282,7 @@ SUBROUTINE test_genprop_class_callback(total_error) INTEGER(hid_t) :: lid2 !/* 2nd Generic Property list ID */ INTEGER(size_t) :: nprops !/* Number of properties in class */ - TYPE cb_struct - INTEGER :: count - INTEGER(hid_t) :: id - END TYPE cb_struct - - TYPE(cb_struct), TARGET :: crt_cb_struct, cls_cb_struct + TYPE(cop_cb_struct_), TARGET :: crt_cb_struct, cls_cb_struct CHARACTER(LEN=7) :: CLASS1_NAME = "Class 1" TYPE(C_FUNPTR) :: f1, f5 |