From c86aedeba1f683daaf0289435450fd4e518fecc4 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Tue, 1 Apr 2014 10:15:26 -0500 Subject: [svn-r24939] Fix for HDFFV-8309 Fortran wrappers for H5Pget/set_file_image functions Tested: jam (gnu, intel, pgi) --- fortran/src/H5Fff_F03.f90 | 11 ++-- fortran/src/H5Pf.c | 70 +++++++++++++++++++++++ fortran/src/H5Pff_F03.f90 | 106 +++++++++++++++++++++++++++++++++++ fortran/src/H5f90proto.h | 4 ++ fortran/src/hdf5_fortrandll.def.in | 2 + fortran/test/fortranlib_test_F03.f90 | 4 ++ fortran/test/tH5P_F03.f90 | 91 +++++++++++++++++++++++++++--- 7 files changed, 272 insertions(+), 16 deletions(-) diff --git a/fortran/src/H5Fff_F03.f90 b/fortran/src/H5Fff_F03.f90 index 83d46be..d819c34 100644 --- a/fortran/src/H5Fff_F03.f90 +++ b/fortran/src/H5Fff_F03.f90 @@ -30,13 +30,11 @@ ! !***** - MODULE H5F_PROVISIONAL USE H5GLOBAL USE, INTRINSIC :: ISO_C_BINDING - CONTAINS !****s* H5F (F03)/h5fget_file_image_f_F03 ! @@ -82,14 +80,13 @@ CONTAINS !DEC$IF DEFINED(HDF5F90_WINDOWS) !DEC$ATTRIBUTES C,reference,decorate,alias:'H5FGET_FILE_IMAGE_C'::h5fget_file_image_c !DEC$ENDIF - INTEGER(HID_T) , INTENT(IN) :: file_id - TYPE(C_PTR) , VALUE :: buf_ptr - INTEGER(SIZE_T) , INTENT(IN) :: buf_len - INTEGER(SIZE_T), INTENT(IN) :: buf_size + INTEGER(HID_T) , INTENT(IN) :: file_id + TYPE(C_PTR) , VALUE :: buf_ptr + INTEGER(SIZE_T), INTENT(IN) :: buf_len + INTEGER(SIZE_T), INTENT(IN) :: buf_size END FUNCTION h5fget_file_image_c END INTERFACE - IF(PRESENT(buf_size))THEN buf_ptr = C_NULL_PTR ENDIF diff --git a/fortran/src/H5Pf.c b/fortran/src/H5Pf.c index 7a3f899..98e5ff6 100644 --- a/fortran/src/H5Pf.c +++ b/fortran/src/H5Pf.c @@ -5546,3 +5546,73 @@ nh5pget_chunk_cache_c(hid_t_f *dapl_id, size_t_f *rdcc_nslots, size_t_f *rdcc_nb ret_value = 0; return ret_value; } + +/*---------------------------------------------------------------------------- + * Name: h5pset_file_image_c + * Purpose: Calls H5Pset_file_image + * + * Inputs: + * fapl_id - File access property list identifier + * buf_ptr - Pointer to the initial file image, + * or NULL if no initial file image is desired + * buf_len - Size of the supplied buffer, or 0 (zero) if no initial image is desired + * + * Returns: 0 on success, -1 on failure + * Programmer: M. Scot Breitenfeld + * February 19, 2012 + *---------------------------------------------------------------------------*/ + +int_f +nh5pset_file_image_c(hid_t_f *fapl_id, void *buf_ptr, size_t_f *buf_len) +{ + int ret_value = -1; + /* + * Call H5Pset_file_image function. + */ + if( (H5Pset_file_image((hid_t)*fapl_id, buf_ptr, (size_t)*buf_len)) <0 ) + return ret_value; /* error occurred */ + + ret_value = 0; + return ret_value; +} + +/*---------------------------------------------------------------------------- + * Name: h5pget_file_image_c + * Purpose: Calls H5Pget_file_image + * + * Inputs: + * fapl_id - File access property list identifier + * Outputs: + * buf_ptr - Pointer to the initial file image, + * or NULL if no initial file image is desired + * buf_len - Size of the supplied buffer, or 0 (zero) if no initial image is desired + * + * Returns: 0 on success, -1 on failure + * Programmer: M. Scot Breitenfeld + * February 19, 2012 + *---------------------------------------------------------------------------*/ + +int_f +nh5pget_file_image_c(hid_t_f *fapl_id, void **buf_ptr, size_t_f *buf_len_ptr) +{ + int ret_value = -1; + size_t c_buf_len_ptr; + void *c_buf_ptr = NULL; + + c_buf_len_ptr = (size_t)*buf_len_ptr; + + /* + * Call H5Pget_file_image function. + */ + if( (H5Pget_file_image((hid_t)*fapl_id, (void **)&c_buf_ptr, &c_buf_len_ptr)) <0 ) + return ret_value; /* error occurred */ + + HDmemcpy((void *)*buf_ptr, (void *)c_buf_ptr, c_buf_len_ptr); + + *buf_len_ptr=(size_t_f)c_buf_len_ptr; + + ret_value = 0; + if(c_buf_ptr) HDfree(c_buf_ptr); + + return ret_value; +} diff --git a/fortran/src/H5Pff_F03.f90 b/fortran/src/H5Pff_F03.f90 index 7fb6ff9..806c308 100644 --- a/fortran/src/H5Pff_F03.f90 +++ b/fortran/src/H5Pff_F03.f90 @@ -1181,5 +1181,111 @@ CONTAINS END SUBROUTINE h5pcreate_class_f +! +!****s* H5P (F03)/h5pset_file_image_f_F03 +! +! NAME +! h5pset_file_image_f +! +! PURPOSE +! Sets an initial file image in a memory buffer. +! +! Inputs: +! fapl_id - File access property list identifier +! buf_ptr - Pointer to the initial file image, +! or C_NULL_PTR if no initial file image is desired +! buf_len - Size of the supplied buffer, or 0 (zero) if no initial image is desired +! +! Outputs: +! hdferr - Returns 0 if successful and -1 if fails +! +! AUTHOR +! M. Scot Breitenfeld +! February 19, 2012 +! +! Fortran2003 Interface: + SUBROUTINE h5pset_file_image_f(fapl_id, buf_ptr, buf_len, hdferr) + USE iso_c_binding + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: fapl_id + TYPE(C_PTR) , INTENT(IN) :: buf_ptr + INTEGER(SIZE_T), INTENT(IN) :: buf_len + INTEGER , INTENT(OUT) :: hdferr +!***** + INTERFACE + INTEGER FUNCTION h5pset_file_image_c(fapl_id, buf_ptr, buf_len) + USE iso_c_binding + USE H5GLOBAL + !DEC$IF DEFINED(HDCLOSEF90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5PSET_FILE_IMAGE_C'::h5pset_file_image_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: fapl_id + TYPE(C_PTR), VALUE :: buf_ptr + INTEGER(SIZE_T), INTENT(IN) :: buf_len + END FUNCTION h5pset_file_image_c + END INTERFACE + + hdferr = h5pset_file_image_c(fapl_id, buf_ptr, buf_len) + + END SUBROUTINE h5pset_file_image_f +! +!****s* H5P (F03)/h5pget_file_image_f_F03 +! +! NAME +! h5pget_file_image_f +! +! PURPOSE +! Retrieves a copy of the file image designated as the initial content and structure of a file. +! +! Inputs: +! fapl_id - File access property list identifier. +! +! Outputs: +! buf_ptr - Will hold either a C_NULL_PTR or a scalar of type +! c_loc. If buf_ptr is not C_NULL_PTR, on successful +! return, buf_ptr shall contain a C pointer to a copy +! of the initial image provided in the last call to +! H5Pset_file_image_f for the supplied fapl_id, or +! buf_ptr shall contain a C_NULL_PTR if there is no +! initial image set. +! +! buf_len_ptr - Contains the value of the buffer parameter for +! the initial image in the supplied fapl_id. The value +! will be 0 if no initial image is set. +! +! +! hdferr - Returns 0 if successful and -1 if fails +! +! AUTHOR +! M. Scot Breitenfeld +! February 19, 2012 +! +! Fortran2003 Interface: + SUBROUTINE h5pget_file_image_f(fapl_id, buf_ptr, buf_len_ptr, hdferr) + USE iso_c_binding + IMPLICIT NONE + INTEGER(HID_T) , INTENT(IN) :: fapl_id + TYPE(C_PTR) , INTENT(OUT), DIMENSION(*) :: buf_ptr + INTEGER(SIZE_T), INTENT(OUT) :: buf_len_ptr + INTEGER , INTENT(OUT) :: hdferr + +!***** + INTERFACE + INTEGER FUNCTION h5pget_file_image_c(fapl_id, buf_ptr, buf_len_ptr) + USE iso_c_binding + USE H5GLOBAL + !DEC$IF DEFINED(HDCLOSEF90_WINDOWS) + !DEC$ATTRIBUTES C,reference,decorate,alias:'H5PGET_FILE_IMAGE_C'::h5pget_file_image_c + !DEC$ENDIF + INTEGER(HID_T), INTENT(IN) :: fapl_id + TYPE(C_PTR), DIMENSION(*), INTENT(OUT) :: buf_ptr + INTEGER(SIZE_T), INTENT(OUT) :: buf_len_ptr + END FUNCTION h5pget_file_image_c + END INTERFACE + + hdferr = h5pget_file_image_c(fapl_id, buf_ptr, buf_len_ptr) + + END SUBROUTINE h5pget_file_image_f + END MODULE H5P_PROVISIONAL diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h index ae848bf..a0a4f64 100644 --- a/fortran/src/H5f90proto.h +++ b/fortran/src/H5f90proto.h @@ -863,11 +863,13 @@ H5_FCDLL int_f nh5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f * #define nh5pget_preserve_c H5_FC_FUNC_(h5pget_preserve_c, H5PGET_PRESERVE_C) #define nh5pset_chunk_c H5_FC_FUNC_(h5pset_chunk_c, H5PSET_CHUNK_C) #define nh5pget_chunk_c H5_FC_FUNC_(h5pget_chunk_c, H5PGET_CHUNK_C) +#define nh5pset_file_image_c H5_FC_FUNC_(h5pset_file_image_c,H5PSET_FILE_IMAGE_C) #define nh5pset_fill_valuec_c H5_FC_FUNC_(h5pset_fill_valuec_c, H5PSET_FILL_VALUEC_C) #define nh5pset_fill_value_c H5_FC_FUNC_(h5pset_fill_value_c, H5PSET_FILL_VALUE_C) #define nh5pset_fill_value_integer_c H5_FC_FUNC_(h5pset_fill_value_integer_c, H5PSET_FILL_VALUE_INTEGER_C) #define nh5pset_fill_value_real_c H5_FC_FUNC_(h5pset_fill_value_real_c, H5PSET_FILL_VALUE_REAL_C) #define nh5pset_fill_value_double_c H5_FC_FUNC_(h5pset_fill_value_double_c, H5PSET_FILL_VALUE_DOUBLE_C) +#define nh5pget_file_image_c H5_FC_FUNC_(h5pget_file_image_c,H5PGET_FILE_IMAGE_C) #define nh5pget_fill_valuec_c H5_FC_FUNC_(h5pget_fill_valuec_c, H5PGET_FILL_VALUEC_C) #define nh5pget_fill_value_c H5_FC_FUNC_(h5pget_fill_value_c, H5PGET_FILL_VALUE_C) #define nh5pget_fill_value_integer_c H5_FC_FUNC_(h5pget_fill_value_integer_c, H5PGET_FILL_VALUE_INTEGER_C) @@ -1017,11 +1019,13 @@ H5_FCDLL int_f nh5pget_class_c ( hid_t_f *prp_id , int_f *classtype); H5_FCDLL int_f nh5pset_deflate_c ( hid_t_f *prp_id , int_f *level); H5_FCDLL int_f nh5pset_chunk_c ( hid_t_f *prp_id, int_f *rank, hsize_t_f *dims ); H5_FCDLL int_f nh5pget_chunk_c ( hid_t_f *prp_id, int_f *max_rank, hsize_t_f *dims ); +H5_FCDLL int_f nh5pset_file_image_c (hid_t_f *fapl_id, void *buf_ptr, size_t_f *buf_len); H5_FCDLL int_f nh5pset_fill_valuec_c (hid_t_f *prp_id, hid_t_f *type_id, _fcd fillvalue); H5_FCDLL int_f nh5pset_fill_value_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue); H5_FCDLL int_f nh5pset_fill_value_integer_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue); H5_FCDLL int_f nh5pset_fill_value_real_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue); H5_FCDLL int_f nh5pset_fill_value_double_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue); +H5_FCDLL int_f nh5pget_file_image_c (hid_t_f *fapl_id, void **buf_ptr, size_t_f *buf_len); H5_FCDLL int_f nh5pget_fill_valuec_c (hid_t_f *prp_id, hid_t_f *type_id, _fcd fillvalue); H5_FCDLL int_f nh5pget_fill_value_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue); H5_FCDLL int_f nh5pget_fill_value_integer_c (hid_t_f *prp_id, hid_t_f *type_id, void *fillvalue); diff --git a/fortran/src/hdf5_fortrandll.def.in b/fortran/src/hdf5_fortrandll.def.in index c549d34..41e93e4 100644 --- a/fortran/src/hdf5_fortrandll.def.in +++ b/fortran/src/hdf5_fortrandll.def.in @@ -454,6 +454,8 @@ H5P_mp_H5PGET_CHUNK_CACHE_F @H5_NOF03EXP@H5P_PROVISIONAL_mp_H5PGET_PTR @H5_NOF03EXP@H5P_PROVISIONAL_mp_H5PREGISTER_PTR @H5_NOF03EXP@H5P_PROVISIONAL_mp_H5PINSERT_PTR +@H5_NOF03EXP@H5P_PROVISIONAL_mp_H5PGET_FILE_IMAGE_F +@H5_NOF03EXP@H5P_PROVISIONAL_mp_H5PSET_FILE_IMAGE_F ; H5R H5R_PROVISIONAL_mp_H5RCREATE_OBJECT_F H5R_PROVISIONAL_mp_H5RCREATE_REGION_F diff --git a/fortran/test/fortranlib_test_F03.f90 b/fortran/test/fortranlib_test_F03.f90 index 1d9615f..dbdc184 100644 --- a/fortran/test/fortranlib_test_F03.f90 +++ b/fortran/test/fortranlib_test_F03.f90 @@ -149,6 +149,10 @@ PROGRAM fortranlibtest_F03 CALL external_test_offset(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Testing external dataset with offset', total_error) + ret_total_error = 0 + CALL test_h5p_file_image(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing h5pset/get file image', total_error) + ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing GROUP interface ' diff --git a/fortran/test/tH5P_F03.f90 b/fortran/test/tH5P_F03.f90 index 02ca9dc..f5fd041 100644 --- a/fortran/test/tH5P_F03.f90 +++ b/fortran/test/tH5P_F03.f90 @@ -231,15 +231,15 @@ END SUBROUTINE test_create SUBROUTINE test_genprop_class_callback(total_error) - !/**************************************************************** - !** - !** test_genprop_class_callback(): Test basic generic property list code. - !** Tests callbacks for property lists in a generic class. - !** - !** FORTRAN TESTS: - !** Tests function H5Pcreate_class_f with callback. - !** - !****************************************************************/ + ! + ! + ! test_genprop_class_callback(): Test basic generic property list code. + ! Tests callbacks for property lists in a generic class. + ! + ! FORTRAN TESTS: + ! Tests function H5Pcreate_class_f with callback. + ! + ! USE HDF5 USE ISO_C_BINDING @@ -364,6 +364,79 @@ SUBROUTINE test_genprop_class_callback(total_error) END SUBROUTINE test_genprop_class_callback !------------------------------------------------------------------------- +! Function: test_h5p_file_image +! +! Purpose: Tests APIs: +! h5pget_file_image_f and h5pset_file_image_f +! +! Return: Success: 0 +! Failure: -1 +! +! FORTRAN Programmer: M. Scot Breitenfeld +! April 1, 2014 +!------------------------------------------------------------------------- + +SUBROUTINE test_h5p_file_image(total_error) + + USE HDF5 + USE ISO_C_BINDING + IMPLICIT NONE + INTEGER, INTENT(INOUT) :: total_error + INTEGER(hid_t) :: fapl_1 = -1 + INTEGER, PARAMETER :: count = 10 + INTEGER, DIMENSION(1:count), TARGET :: buffer + INTEGER, DIMENSION(1:count), TARGET :: temp + INTEGER :: i + INTEGER(size_t) :: size + INTEGER(size_t) :: temp_size + INTEGER :: error ! error return value + TYPE(C_PTR) :: f_ptr + TYPE(C_PTR), DIMENSION(1:count) :: f_ptr1 + TYPE(C_PTR), DIMENSION(1:1) :: f_ptr2 + + ! Initialize file image buffer + + DO i = 1, count + buffer(i) = i*10 + ENDDO + + ! Create fapl + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_1, error) + CALL check("h5pcreate_f", error, total_error) + + ! Test with NULL ptr + f_ptr2 = C_NULL_PTR + temp_size = 1 + CALL h5pget_file_image_f(fapl_1, f_ptr2, temp_size, error) + CALL check("h5pget_file_image_f", error, total_error) + CALL verify("h5pget_file_image_f", temp_size, 0, total_error) + + ! Set file image + f_ptr = C_LOC(buffer(1)) + size = SIZEOF(buffer) + CALL h5pset_file_image_f(fapl_1, f_ptr, size, error) + CALL check("h5pset_file_image_f", error, total_error) + + ! Get the same data back + DO i = 1, count + f_ptr1(i) = C_LOC(temp(i)) + ENDDO + + temp_size = 0 + CALL h5pget_file_image_f(fapl_1, f_ptr1, temp_size, error) + CALL check("h5pget_file_image_f", error, total_error) + + ! Check that sizes are the same, and that the buffers are identical but separate + CALL VERIFY("h5pget_file_image_f", temp_size, size, total_error) + + ! Verify the image data is correct + DO i = 1, count + CALL VERIFY("h5pget_file_image_f", temp(i), buffer(i), total_error) + ENDDO + +END SUBROUTINE test_h5p_file_image + +!------------------------------------------------------------------------- ! Function: external_test_offset ! ! Purpose: Tests APIs: -- cgit v0.12