diff options
| author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2012-03-26 04:12:59 (GMT) |
|---|---|---|
| committer | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2012-03-26 04:12:59 (GMT) |
| commit | e002bb98e17c3502bedd9660d72387da6a662cc2 (patch) | |
| tree | 06478d4d7feea78aff642294e1ed1132dfdb533d /fortran/test/tH5O.f90 | |
| parent | cdc63fc21a4405c6da9473102216b2c2c1bc3887 (diff) | |
| download | hdf5-e002bb98e17c3502bedd9660d72387da6a662cc2.zip hdf5-e002bb98e17c3502bedd9660d72387da6a662cc2.tar.gz hdf5-e002bb98e17c3502bedd9660d72387da6a662cc2.tar.bz2 | |
[svn-r22142] Description : New Fortran wrapper (h5ocopy_f) for the C API H5Ocopy
HDFFV-7965
Tested: jam (gnu), koala (gnu)
Diffstat (limited to 'fortran/test/tH5O.f90')
| -rw-r--r-- | fortran/test/tH5O.f90 | 53 |
1 files changed, 51 insertions, 2 deletions
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 !/**************************************************************** |