From 27a385d557df87a50fdec678c808e669d63d5b82 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Wed, 18 Feb 2015 13:51:13 -0500 Subject: [PATCH] [svn-r26214] Fix for HDFFV-8908: h5tenum_insert_f does not work with default 8 byte integers (xlf compiler) --- fortran/src/H5Tf.c | 43 ++++++++++++ fortran/src/H5Tff.f90 | 51 -------------- fortran/src/H5Tff_F03.f90 | 107 +++++++++++++++++++++++++++++ fortran/src/H5Tff_F90.f90 | 56 +++++++++++++++ fortran/src/H5f90proto.h | 1 + fortran/src/hdf5_fortrandll.def.in | 2 + fortran/test/tH5T_F03.f90 | 2 +- 7 files changed, 210 insertions(+), 52 deletions(-) diff --git a/fortran/src/H5Tf.c b/fortran/src/H5Tf.c index ca9c30fe16..b6bcf5f227 100644 --- a/fortran/src/H5Tf.c +++ b/fortran/src/H5Tf.c @@ -2421,3 +2421,46 @@ h5tconvert_c(hid_t_f *src_id, hid_t_f *dst_id, size_t_f *nelmts, void *buf, void return ret_value; } +/****if* H5Tf/h5tenum_insert_ptr_c + * NAME + * /h5tenum_insert_ptr_c + * PURPOSE + * Calls H5Tenum_insert + * INPUTS + * type_id - Datatype identifier for the enumeration datatype. + * name - Datatype identifier. + * value - Pointer to the value of the new member. + * + * OUTPUTS + * + * RETURNS + * 0 on success, -1 on failure + * AUTHOR + * M. Scot Breitenfeld + * 2/6/2015 + * + * SOURCE +*/ +int_f +h5tenum_insert_ptr_c(hid_t_f *type_id, _fcd name, int_f* namelen, void *value) +/******/ +{ + int ret_value = -1; + hid_t status; + char *c_name; + size_t c_namelen; + + /* + * Convert FORTRAN name to C name + */ + c_namelen = *namelen; + c_name = (char *)HD5f2cstring(name, c_namelen); + if (c_name == NULL) return ret_value; + + status = H5Tenum_insert( (hid_t)*type_id, c_name, value); + if ( status < 0 ) return ret_value; + ret_value = 0; + return ret_value; +} + + diff --git a/fortran/src/H5Tff.f90 b/fortran/src/H5Tff.f90 index 0e1dbb040e..4b4c0b6321 100644 --- a/fortran/src/H5Tff.f90 +++ b/fortran/src/H5Tff.f90 @@ -2335,57 +2335,6 @@ CONTAINS hdferr = h5tenum_create_c(parent_id, new_type_id) END SUBROUTINE h5tenum_create_f - -! -!****s* H5T/h5tenaum_insert_f -! -! NAME -! h5tenaum_insert_f -! -! PURPOSE -! Inserts a new enumeration datatype member. -! -! INPUTS -! type_id - datatype identifier -! OUTPUTS -! hdferr - Returns 0 if successful and -1 if fails -! -! AUTHOR -! Elena Pourmal -! August 12, 1999 -! -! HISTORY -! Explicit Fortran interfaces were added for -! called C functions (it is needed for Windows -! port). March 7, 2001 -! SOURCE - SUBROUTINE h5tenum_insert_f(type_id, name, value, hdferr) - IMPLICIT NONE - INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier - CHARACTER(LEN=*), INTENT(IN) :: name !Name of the new member - INTEGER, INTENT(IN) :: value !value of the new member - INTEGER, INTENT(OUT) :: hdferr ! Error code -!***** - INTEGER :: namelen - - INTERFACE - INTEGER FUNCTION h5tenum_insert_c(type_id, name, namelen, value) - USE H5GLOBAL - !DEC$IF DEFINED(HDF5F90_WINDOWS) - !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TENUM_INSERT_C'::h5tenum_insert_c - !DEC$ENDIF - !DEC$ATTRIBUTES reference :: name - INTEGER(HID_T), INTENT(IN) :: type_id - CHARACTER(LEN=*), INTENT(IN) :: name - INTEGER, INTENT(IN) :: value - INTEGER :: namelen - END FUNCTION h5tenum_insert_c - END INTERFACE - - namelen = LEN(name) - hdferr = h5tenum_insert_c(type_id, name, namelen, value) - END SUBROUTINE h5tenum_insert_f - ! !****s* H5T/h5tenum_nameof_f ! diff --git a/fortran/src/H5Tff_F03.f90 b/fortran/src/H5Tff_F03.f90 index 2405837ca4..beff717cd7 100644 --- a/fortran/src/H5Tff_F03.f90 +++ b/fortran/src/H5Tff_F03.f90 @@ -47,6 +47,11 @@ MODULE H5T_PROVISIONAL !***** + INTERFACE h5tenum_insert_f + MODULE PROCEDURE h5tenum_insert_f03 + MODULE PROCEDURE h5tenum_insert_f90 + END INTERFACE + CONTAINS !****s* H5T (F03)/H5Tconvert_f_F03 @@ -93,6 +98,7 @@ CONTAINS BIND(C, NAME='h5tconvert_c') USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr USE H5GLOBAL + IMPLICIT NONE INTEGER(HID_T) , INTENT(IN) :: src_id INTEGER(HID_T) , INTENT(IN) :: dst_id INTEGER(SIZE_T), INTENT(IN) :: nelmts @@ -111,6 +117,107 @@ CONTAINS hdferr = H5Tconvert_c(src_id, dst_id, nelmts, buf, background_default, plist_id_default) END SUBROUTINE h5tconvert_f +! +!****s* (F03) H5T/h5tenaum_insert_f03 +! +! NAME +! h5tenum_insert_f +! +! PURPOSE +! Inserts a new enumeration datatype member. +! +! INPUTS +! type_id - Datatype identifier for the enumeration datatype. +! name - Datatype identifier. +! value - Value of the new member. +! OUTPUTS +! hdferr - Returns 0 if successful and -1 if fails +! +! AUTHOR +! Elena Pourmal +! August 12, 1999 +! +! HISTORY +! Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). March 7, 2001 +! SOURCE + SUBROUTINE h5tenum_insert_f90(type_id, name, value, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id ! Datatype identifier + CHARACTER(LEN=*), INTENT(IN) :: name !Name of the new member + INTEGER, INTENT(IN) :: value !value of the new member + INTEGER, INTENT(OUT) :: hdferr ! Error code +!***** + INTEGER :: namelen + INTERFACE + INTEGER FUNCTION h5tenum_insert_c(type_id, name, namelen, value) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TENUM_INSERT_C'::h5tenum_insert_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: type_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER, INTENT(IN) :: value + INTEGER :: namelen + END FUNCTION h5tenum_insert_c + END INTERFACE + + namelen = LEN(name) + hdferr = h5tenum_insert_c(type_id, name, namelen, value) + END SUBROUTINE h5tenum_insert_f90 + +! +!****s* (F03) H5T/h5tenaum_insert_f03 +! +! NAME +! h5tenum_insert_f +! +! PURPOSE +! Inserts a new enumeration datatype member. +! +! INPUTS +! type_id - Datatype identifier for the enumeration datatype. +! name - Datatype identifier. +! value - Pointer to the value of the new member. +! OUTPUTS +! hdferr - Returns 0 if successful and -1 if fails +! +! AUTHOR +! M. Scot Breitenfeld +! February 6, 2015 +! +! HISTORY +! F2003 implementation of function +! SOURCE + SUBROUTINE h5tenum_insert_f03(type_id, name, value, hdferr) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr, c_char + USE H5GLOBAL + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: type_id + CHARACTER(LEN=*), INTENT(IN) :: name + TYPE(C_PTR) , INTENT(IN) :: value + INTEGER, INTENT(OUT) :: hdferr +!***** + INTEGER :: namelen + + INTERFACE + INTEGER FUNCTION h5tenum_insert_ptr_c(type_id, name, namelen, value) & + BIND(C, NAME='h5tenum_insert_ptr_c') + USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr, c_char + USE H5GLOBAL + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: type_id + CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: name + INTEGER :: namelen + TYPE(C_PTR), VALUE :: value + END FUNCTION h5tenum_insert_ptr_c + END INTERFACE + + namelen = LEN(name) + hdferr = h5tenum_insert_ptr_c(type_id, name, namelen, value) + END SUBROUTINE h5tenum_insert_f03 END MODULE H5T_PROVISIONAL diff --git a/fortran/src/H5Tff_F90.f90 b/fortran/src/H5Tff_F90.f90 index a95b31fe7b..8540d2b241 100644 --- a/fortran/src/H5Tff_F90.f90 +++ b/fortran/src/H5Tff_F90.f90 @@ -36,4 +36,60 @@ MODULE H5T_PROVISIONAL + USE H5GLOBAL + +CONTAINS + +! +!****s* H5T/h5tenum_insert_f +! +! NAME +! h5tenaum_insert_f +! +! PURPOSE +! Inserts a new enumeration datatype member. +! +! INPUTS +! type_id - Datatype identifier for the enumeration datatype. +! name - Datatype identifier. +! value - Value of the new member. +! OUTPUTS +! hdferr - Returns 0 if successful and -1 if fails +! +! AUTHOR +! Elena Pourmal +! August 12, 1999 +! +! HISTORY +! Explicit Fortran interfaces were added for +! called C functions (it is needed for Windows +! port). March 7, 2001 +! SOURCE + SUBROUTINE h5tenum_insert_f(type_id, name, value, hdferr) + IMPLICIT NONE + INTEGER(HID_T), INTENT(IN) :: type_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER, INTENT(IN) :: value + INTEGER, INTENT(OUT) :: hdferr +!***** + INTEGER :: namelen + + INTERFACE + INTEGER FUNCTION h5tenum_insert_c(type_id, name, namelen, value) + USE H5GLOBAL + !DEC$IF DEFINED(HDF5F90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5TENUM_INSERT_C'::h5tenum_insert_c + !DEC$ENDIF + !DEC$ATTRIBUTES reference :: name + INTEGER(HID_T), INTENT(IN) :: type_id + CHARACTER(LEN=*), INTENT(IN) :: name + INTEGER, INTENT(IN) :: value + INTEGER :: namelen + END FUNCTION h5tenum_insert_c + END INTERFACE + + namelen = LEN(name) + hdferr = h5tenum_insert_c(type_id, name, namelen, value) + END SUBROUTINE h5tenum_insert_f + END MODULE H5T_PROVISIONAL diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index 284ffbdb14..b5e40a885c 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -772,6 +772,7 @@ H5_FCDLL int_f nh5tinsert_array_c(hid_t_f * parent_id, _fcd name, int_f* namelen H5_FCDLL int_f nh5tinsert_array_c2(hid_t_f * parent_id, _fcd name, int_f* namelen, size_t_f* offset, int_f* ndims, size_t_f* dims, hid_t_f* member_id); H5_FCDLL int_f nh5tenum_create_c ( hid_t_f *parent_id , hid_t_f *new_type_id); H5_FCDLL int_f nh5tenum_insert_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value); +H5_FCDLL int_f h5tenum_insert_ptr_c(hid_t_f *type_id, _fcd name, int_f* namelen, void *value); H5_FCDLL int_f nh5tenum_nameof_c(hid_t_f *type_id, int_f* value, _fcd name, size_t_f* namelen); H5_FCDLL int_f nh5tenum_valueof_c(hid_t_f *type_id, _fcd name, int_f* namelen, int_f* value); H5_FCDLL int_f nh5tget_member_value_c(hid_t_f *type_id, int_f* member_no, int_f* value); diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index c9c5e76853..1be377ffbb 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -560,6 +560,8 @@ H5T_mp_H5TGET_CREATE_PLIST_F H5T_mp_H5TCOMPILER_CONV_F H5T_mp_H5TGET_NATIVE_TYPE_F @H5_NOF03EXP@H5T_PROVISIONAL_mp_H5TCONVERT_F +@H5_NOF03EXP@H5T_PROVISIONAL_mp_H5TENUM_INSERT_F90 +@H5_NOF03EXP@H5T_PROVISIONAL_mp_H5TENUM_INSERT_F03 ; H5Z H5Z_mp_H5ZUNREGISTER_F H5Z_mp_H5ZFILTER_AVAIL_F diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90 index f15424db02..d9a671cf23 100644 --- a/fortran/test/tH5T_F03.f90 +++ b/fortran/test/tH5T_F03.f90 @@ -1419,7 +1419,7 @@ SUBROUTINE t_enum(total_error) ! Insert enumerated value for memtype. ! val(1) = i - CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), val(1), error) + CALL H5Tenum_insert_f(memtype, TRIM(names(i+1)), C_LOC(val(1)), error) CALL check("H5Tenum_insert_f", error, total_error) ! ! Insert enumerated value for filetype. We must first convert