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

Tested: jam (gnu, intel, pgi)
 

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: