[svn-r22142] Description : New Fortran wrapper (h5ocopy_f) for the C API H5Ocopy

HDFFV-7965

Tested: jam (gnu), koala (gnu)

4 files changed, 186 insertions, 3 deletions

diff --git a/fortran/src/H5Of.c b/fortran/src/H5Of.c
index 0df433a..531f09c 100644
--- a/fortran/src/H5Of.c
+++ b/fortran/src/H5Of.c
@@ -334,3 +334,60 @@ nh5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *
   return ret_value;
 }
 
+/* ***if* H5Of/H5Ocopy_c
+ * NAME
+ *  H5Ocopy_c
+ * PURPOSE
+ *  Calls H5Ocopy
+ * INPUTS  
+ *  src_loc_id   - Object identifier indicating the location of the source object to be copied 
+ *  src_name     - Name of the source object to be copied 
+ *  src_name_len - Length of src_name
+ *  dst_loc_id   - Location identifier specifying the destination 
+ *  dst_name     - Name to be assigned to the new copy 
+ *  dst_name_len - Length of dst_name
+ *  ocpypl_id    - Object copy property list
+ *  lcpl_id      - Link creation property list for the new hard link
+ *
+ * RETURNS
+ *  0 on success, -1 on failure
+ * AUTHOR
+ *  M. Scot Breitenfeld
+ *  March 14, 2012
+ * SOURCE
+*/
+int_f
+nh5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len,
+	    hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len, 
+	    hid_t_f *ocpypl_id, hid_t_f *lcpl_id )
+/******/
+{
+  char *c_src_name = NULL;  /* Buffer to hold C string */
+  char *c_dst_name = NULL;  /* Buffer to hold C string */
+  
+  int_f ret_value = 0;      /* Return value */
+  
+  /*
+   * Convert FORTRAN name to C name
+   */
+  if((c_src_name = HD5f2cstring(src_name, (size_t)*src_name_len)) == NULL)
+    HGOTO_DONE(FAIL);
+  if((c_dst_name = HD5f2cstring(dst_name, (size_t)*dst_name_len)) == NULL)
+    HGOTO_DONE(FAIL);
+
+  /*
+   * Call H5Ocopy function.
+   */
+  if(H5Ocopy( (hid_t)*src_loc_id, c_src_name, (hid_t)*dst_loc_id, c_dst_name, 
+	      (hid_t)*ocpypl_id, (hid_t)*lcpl_id) < 0)
+    HGOTO_DONE(FAIL);
+
+ done:
+  if(c_src_name)
+    HDfree(c_src_name);
+  if(c_dst_name)
+    HDfree(c_dst_name);
+
+  return ret_value;
+
+}
diff --git a/fortran/src/H5Off.f90 b/fortran/src/H5Off.f90
index e69fdb5..04c96e2 100644
--- a/fortran/src/H5Off.f90
+++ b/fortran/src/H5Off.f90
@@ -250,5 +250,77 @@ CONTAINS
 
   END SUBROUTINE h5oopen_by_addr_f
 
+!
+!****s* H5O/h5ocopy_f
+! NAME		
+!  h5ocopy_f 
+!
+! PURPOSE
+!  Copies an object in an HDF5 file.
+!
+! INPUTS  
+!  src_loc_id - Object identifier indicating the location of the source object to be copied 
+!  src_name   - Name of the source object to be copied 
+!  dst_loc_id - Location identifier specifying the destination 
+!  dst_name   - Name to be assigned to the new copy
+!
+! OPTIONAL PARAMETERS
+!  ocpypl_id  - Object copy property list
+!  lcpl_id    - Link creation property list for the new hard link
+!
+! OUTPUTS: 
+!  hdferr     - Returns 0 if successful and -1 if fails
+!
+! AUTHOR	
+!  M. Scot Breitenfeld
+!  March 14, 2012
+! 
+! SOURCE
+  SUBROUTINE h5ocopy_f(src_loc_id, src_name, dst_loc_id, dst_name, hdferr, ocpypl_id, lcpl_id)
+    IMPLICIT NONE
+    INTEGER(HID_T)  , INTENT(IN) :: src_loc_id
+    CHARACTER(LEN=*), INTENT(IN) :: src_name
+    INTEGER(HID_T)  , INTENT(IN) :: dst_loc_id
+    CHARACTER(LEN=*), INTENT(IN) :: dst_name
+    INTEGER, INTENT(OUT) :: hdferr
+    INTEGER(HID_T)  , INTENT(IN), OPTIONAL :: ocpypl_id
+    INTEGER(HID_T)  , INTENT(IN), OPTIONAL :: lcpl_id
+!*****
+
+    INTEGER(SIZE_T) :: src_name_len, dst_name_len
+    INTEGER(HID_T)  :: ocpypl_id_default, lcpl_id_default
+
+    INTERFACE
+       INTEGER FUNCTION h5ocopy_c(src_loc_id, src_name, src_name_len, &
+            dst_loc_id, dst_name, dst_name_len, ocpypl_id_default, lcpl_id_default)
+         USE H5GLOBAL
+         !DEC$IF DEFINED(HDF5F90_WINDOWS)
+         !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OCOPY_C'::h5ocopy_c
+         !DEC$ENDIF
+         !DEC$ATTRIBUTES reference :: src_name, dst_name
+         INTEGER(HID_T)  , INTENT(IN) :: src_loc_id
+         CHARACTER(LEN=*), INTENT(IN) :: src_name
+         INTEGER(HID_T)  , INTENT(IN) :: dst_loc_id
+         CHARACTER(LEN=*), INTENT(IN) :: dst_name
+         INTEGER(HID_T)  , INTENT(IN) :: ocpypl_id_default
+         INTEGER(HID_T)  , INTENT(IN) :: lcpl_id_default
+         INTEGER(SIZE_T)              :: src_name_len, dst_name_len
+
+       END FUNCTION h5ocopy_c
+    END INTERFACE
+
+    src_name_len = LEN(src_name)
+    dst_name_len = LEN(dst_name)
+
+    ocpypl_id_default = H5P_DEFAULT_F
+    IF(PRESENT(ocpypl_id)) ocpypl_id_default = ocpypl_id
+    lcpl_id_default = H5P_DEFAULT_F
+    IF(PRESENT(lcpl_id)) lcpl_id_default = lcpl_id
+
+    hdferr = h5ocopy_c(src_loc_id, src_name, src_name_len, &
+         dst_loc_id, dst_name, dst_name_len, ocpypl_id_default, lcpl_id_default)
+
+  END SUBROUTINE h5ocopy_f
+
 END MODULE H5O
 
diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h
index 89957a4..a504653 100644
--- a/fortran/src/H5f90proto.h
+++ b/fortran/src/H5f90proto.h
@@ -805,10 +805,12 @@ H5_FCDLL int_f nh5tconvert_c(hid_t_f *src_id, hid_t_f *dst_id, size_t_f *nelmts,
 
 #define nh5olink_c       H5_FC_FUNC_(h5olink_c, H5OLINK_C)
 #define nh5oopen_c       H5_FC_FUNC_(h5oopen_c, H5OOPEN_C)
-#define nh5oclose_c       H5_FC_FUNC_(h5oclose_c, H5OCLOSE_C)
+#define nh5oclose_c      H5_FC_FUNC_(h5oclose_c, H5OCLOSE_C)
 #define nh5ovisit_c      H5_FC_FUNC_(h5ovisit_c,H5OVISIT_C)
 #define nh5oget_info_by_name_c H5_FC_FUNC_(h5oget_info_by_name_c ,H5OGET_INFO_BY_NAME_C)
 #define nh5oopen_by_addr_c H5_FC_FUNC_(h5oopen_by_addr_c, H5OOPEN_BY_ADDR_C)
+#define nh5ocopy_c         H5_FC_FUNC_(h5ocopy_c, H5OCOPY_C)
+
 
 H5_FCDLL int_f nh5oopen_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id, hid_t_f *obj_id);
 H5_FCDLL int_f nh5oclose_c (hid_t_f *object_id );
@@ -818,6 +820,9 @@ H5_FCDLL int_f nh5olink_c (hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, s
 H5_FCDLL int_f nh5ovisit_c (hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data);
 H5_FCDLL int_f nh5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen,hid_t_f *lapl_id,
 				       H5O_info_t_f *object_info);
+H5_FCDLL int_f nh5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len,
+			   hid_t_f *dst_loc_id, _fcd dst_name, size_t_f *dst_name_len, 
+			   hid_t_f *ocpypl_id, hid_t_f *lcpl_id );
 /*
  * Functions from H5Pf.c
  */
diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90
index d871e59..f49906b 100644
--- a/fortran/test/tH5O.f90
+++ b/fortran/test/tH5O.f90
@@ -87,6 +87,11 @@ SUBROUTINE test_h5o_link(total_error)
   INTEGER :: i, n, j
   INTEGER ::  error  ! /* Value returned from API calls */
 
+  CHARACTER(LEN=14) :: NAME_DATATYPE_SIMPLE="H5T_NATIVE_INT"
+  CHARACTER(LEN=16) :: NAME_DATATYPE_SIMPLE2="H5T_NATIVE_INT-2"
+  INTEGER(HID_T) :: tid, tid2
+  LOGICAL :: flag
+
   ! /* Initialize the raw data */
   DO i = 1, TEST6_DIM1
      DO j = 1, TEST6_DIM2
@@ -222,8 +227,6 @@ SUBROUTINE test_h5o_link(total_error)
   CALL h5tclose_f(type_id, error)
   CALL check("h5tclose_f",error,total_error)
 
-  CALL h5fclose_f(file_id, error)
-  CALL check("h5fclose_f",error,total_error)
 
   ! /* Close remaining IDs */
   CALL h5sclose_f(space_id, error)
@@ -231,6 +234,52 @@ SUBROUTINE test_h5o_link(total_error)
   CALL h5pclose_f(lcpl_id,error)
   CALL check("h5pclose_f", error, total_error)
 
+  
+  ! *********************
+  !    CHECK H5OCOPY_F
+  ! *********************
+
+  ! create datatype
+  CALL h5tcopy_f(H5T_NATIVE_INTEGER, tid, error)
+  CALL check("h5tcopy_f", error, total_error)
+
+  ! create named datatype
+  CALL h5tcommit_f(file_id, NAME_DATATYPE_SIMPLE, tid, error)
+  CALL check("h5tcommit_f", error, total_error)
+
+  ! close the datatype
+  CALL h5tclose_f(tid, error)
+  CALL check("h5tclose_f",error)
+
+  CALL h5ocopy_f(file_id, NAME_DATATYPE_SIMPLE, file_id, NAME_DATATYPE_SIMPLE2, error)
+  CALL check("h5ocopy_f",error,total_error)
+
+  ! open the datatype for copy
+  CALL h5topen_f(file_id, NAME_DATATYPE_SIMPLE, tid, error)
+  CALL check("h5topen_f",error,total_error)
+
+  ! open the copied datatype
+  CALL h5topen_f(file_id, NAME_DATATYPE_SIMPLE2, tid2, error)
+  CALL check("h5topen_f",error,total_error)
+
+  ! Compare the datatypes
+  CALL h5tequal_f(tid, tid2, flag, error)
+  IF(.NOT.flag)THEN
+     WRITE(*,*) "h5ocopy_f FAILED" 
+     total_error = total_error + 1
+  ENDIF
+
+  ! close the destination datatype
+  CALL h5tclose_f(tid, error)
+  CALL check("h5tclose_f",error,total_error)
+
+  ! close the destination datatype
+  CALL h5tclose_f(tid2, error)
+  CALL check("h5tclose_f",error,total_error)
+
+  CALL h5fclose_f(file_id, error)
+  CALL check("h5fclose_f",error,total_error)
+
 END SUBROUTINE test_h5o_link
 
 !/****************************************************************