mirror/hdf5
2
0
Fork 0
mirror of https://github.com/HDFGroup/hdf5.git synced 2025-01-12 15:04:59 +08:00
Code Issues Packages Projects Releases Wiki Activity

[svn-r24939] Fix for HDFFV-8309 Fortran wrappers for H5Pget/set_file_image functions

Browse Source 
Tested: jam (gnu, intel, pgi)
This commit is contained in:
Scot Breitenfeld 2014-04-01 10:15:26 -05:00
parent 0fcac56705
commit c86aedeba1
7 changed files with 272 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
fortran/src/H5Fff_F03.f90
View File

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

70
fortran/src/H5Pf.c
View File

@ -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;
}

106
fortran/src/H5Pff_F03.f90
View File

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

4
fortran/src/H5f90proto.h
View File

@ -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);

2
fortran/src/hdf5_fortrandll.def.in
View File

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

4
fortran/test/fortranlib_test_F03.f90
View File

@ -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 '

91
fortran/test/tH5P_F03.f90
View File

@ -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
@ -363,6 +363,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
!