summaryrefslogtreecommitdiffstats
path: root/fortran/test/tH5T.f90
diff options
context:
space:
mode:
Diffstat (limited to 'fortran/test/tH5T.f90')
-rw-r--r--fortran/test/tH5T.f9053
1 files changed, 16 insertions, 37 deletions
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index b42a8e6..60ddefb 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -27,6 +27,10 @@
!
!*****
+MODULE TH5T
+
+CONTAINS
+
SUBROUTINE compoundtest(cleanup, total_error)
!
! This program creates a dataset that is one dimensional array of
@@ -43,8 +47,8 @@
! h5tget_class_f, h5tget_member_name_f, h5tget_member_offset_f, h5tget_member_type_f,
! h5tequal_f, h5tinsert_array_f, h5tcommit_f, h5tencode_f, h5tdecode_f
-
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -105,11 +109,10 @@
CHARACTER(LEN=1024) :: cmpd_buf
INTEGER(SIZE_T) :: cmpd_buf_size=0
- INTEGER(HID_T) :: decoded_sid1
INTEGER(HID_T) :: decoded_tid1
INTEGER(HID_T) :: fixed_str1, fixed_str2
- LOGICAL :: are_equal
+ LOGICAL :: are_equal, differ
INTEGER(SIZE_T), PARAMETER :: str_size = 10
INTEGER(SIZE_T) :: query_size
@@ -242,36 +245,6 @@
offset = offset + type_sized ! Offset of the last member is 14
CALL h5tinsert_f(dtype_id, "real_field", offset, H5T_NATIVE_REAL, error)
CALL check("h5tinsert_f", error, total_error)
-
-!!$ !/*-----------------------------------------------------------------------
-!!$ ! * Test encoding and decoding compound datatypes
-!!$ ! *-----------------------------------------------------------------------
-!!$ !*/
-!!$ ! /* Encode compound type in a buffer */
-!!$
-!!$ ! First find the buffer size
-!!$
-!!$ CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error)
-!!$ CALL check("H5Tencode_f", error, total_error)
-!!$
-!!$ ! /* Try decoding bogus buffer */
-!!$
-!!$ CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error)
-!!$ CALL VERIFY("H5Tdecode_f", error, -1, total_error)
-!!$
-!!$ CALL H5Tencode_f(dtype_id, cmpd_buf, cmpd_buf_size, error)
-!!$ CALL check("H5Tencode_f", error, total_error)
-!!$
-!!$ ! /* Decode from the compound buffer and return an object handle */
-!!$ CALL H5Tdecode_f(cmpd_buf, decoded_tid1, error)
-!!$ CALL check("H5Tdecode_f", error, total_error)
-!!$
-!!$ ! /* Verify that the datatype was copied exactly */
-!!$
-!!$ CALL H5Tequal_f(decoded_tid1, dtype_id, flag, error)
-!!$ CALL check("H5Tequal_f", error, total_error)
-!!$ CALL VerifyLogical("H5Tequal_f", flag, .TRUE., total_error)
-
!
! Create the dataset with compound datatype.
!
@@ -555,7 +528,8 @@
CALL h5dread_f(dset_id, dt3_id, double_member_out, data_dims, error)
CALL check("h5dread_f", error, total_error)
do i = 1, dimsize
- if (double_member_out(i) .ne. double_member(i)) then
+ CALL compare_floats(double_member_out(i), double_member(i), differ)
+ if (differ) then
write(*,*) " Wrong double precision data is read back "
total_error = total_error + 1
endif
@@ -573,7 +547,8 @@
CALL h5dread_f(dset_id, dt4_id, real_member_out, data_dims, error)
CALL check("h5dread_f", error, total_error)
do i = 1, dimsize
- if (real_member_out(i) .ne. real_member(i)) then
+ CALL compare_floats(real_member_out(i), real_member(i), differ)
+ if (differ) then
write(*,*) " Wrong real precision data is read back "
total_error = total_error + 1
endif
@@ -632,7 +607,7 @@
- SUBROUTINE basic_data_type_test(cleanup, total_error)
+ SUBROUTINE basic_data_type_test(total_error)
! This subroutine tests following functionalities:
! H5tget_precision_f, H5tset_precision_f, H5tget_offset_f
@@ -642,9 +617,9 @@
! H5tset_cset_f, H5tget_strpad_f, H5tset_strpad_f
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
- LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error
INTEGER(HID_T) :: dtype1_id, dtype2_id, dtype3_id, dtype4_id, dtype5_id
@@ -859,6 +834,7 @@
SUBROUTINE enumtest(cleanup, total_error)
USE HDF5
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -999,6 +975,7 @@
SUBROUTINE test_derived_flt(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
+ USE TH5_MISC
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
@@ -1181,3 +1158,5 @@ SUBROUTINE test_derived_flt(cleanup, total_error)
CALL check("h5_cleanup_f", error, total_error)
END SUBROUTINE test_derived_flt
+
+END MODULE TH5T