summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--MANIFEST1
-rw-r--r--fortran/test/tH5A.f9029
-rw-r--r--fortran/test/tH5P.f9024
-rw-r--r--fortran/test/tH5P_F03.f9017
-rw-r--r--fortran/test/tH5T.f9020
-rw-r--r--fortran/test/tH5T_F03.f9037
-rw-r--r--fortran/test/tH5VL.f9010
-rw-r--r--fortran/test/tf.f9058
-rw-r--r--fortran/test/tf_include.f9037
9 files changed, 137 insertions, 96 deletions
diff --git a/MANIFEST b/MANIFEST
index 40ae2f1..0145eeb 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -352,6 +352,7 @@
./fortran/test/t.c
./fortran/test/t.h
./fortran/test/tf.f90
+./fortran/test/tf_include.f90
./fortran/test/tH5A.f90
./fortran/test/tH5A_1_8.f90
./fortran/test/tH5D.f90
diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90
index b43707c..5ba2d62 100644
--- a/fortran/test/tH5A.f90
+++ b/fortran/test/tH5A.f90
@@ -117,7 +117,7 @@ CONTAINS
!
!general purpose integer
!
- INTEGER :: i, j
+ INTEGER :: i, j, wp
INTEGER :: error ! Error flag
!
@@ -129,8 +129,6 @@ CONTAINS
!data buffers
!
INTEGER, DIMENSION(NX,NY) :: data_in
- LOGICAL :: differ
-
!
!Initialize data_in buffer
@@ -519,27 +517,22 @@ CONTAINS
data_dims(1) = 1
CALL h5aread_f(attr3_id, H5T_NATIVE_DOUBLE, aread_double_data, data_dims, error)
CALL check("h5aread_f",error,total_error)
- differ = .FALSE.
- if(abs(aread_double_data(1)- 3.459D0) .ge. 1.D-08) then
- differ = .TRUE.
- endif
- ! This is a temporary fix
- !CALL compare_floats(aread_double_data(1), 3.459D0, differ)
- IF (differ) THEN
- WRITE(*,*) "Read back double attrbute is wrong", aread_double_data(1)
- total_error = total_error + 1
- END IF
+
+ IF( .NOT.(aread_double_data(1) .REALEQ. 3.459_Fortran_DOUBLE) )THEN
+ WRITE(*,*) "Read back double attrbute is wrong", aread_double_data(1)
+ total_error = total_error + 1
+ ENDIF
!
!read the real attribute data back to memory
!
data_dims(1) = 1
CALL h5aread_f(attr4_id, H5T_NATIVE_REAL, aread_real_data, data_dims, error)
CALL check("h5aread_f",error,total_error)
- CALL compare_floats(aread_real_data(1), 4.0, differ)
- IF (differ) THEN
- WRITE(*,*) "Read back real attrbute is wrong ", aread_real_data
- total_error = total_error + 1
- END IF
+
+ IF( .NOT.(aread_real_data(1) .REALEQ. REAL(4.0)) )THEN
+ WRITE(*,*) "Read back real attrbute is wrong", aread_real_data(1)
+ total_error = total_error + 1
+ ENDIF
!
!read the Integer attribute data back to memory
!
diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90
index 454f507..0ed12d2 100644
--- a/fortran/test/tH5P.f90
+++ b/fortran/test/tH5P.f90
@@ -450,8 +450,6 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
INTEGER(size_t) rdcc_nelmts
INTEGER(size_t) rdcc_nbytes
REAL :: rdcc_w0
- LOGICAL :: differ
-
CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
IF (error .NE. 0) THEN
@@ -474,8 +472,8 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_1), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_1), INT(nbytes_4), total_error)
- CALL compare_floats(w0_1, w0_4, differ)
- IF(differ)THEN
+
+ IF( .NOT.( w0_1 .REALEQ. w0_4) )THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
@@ -533,8 +531,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- CALL compare_floats(w0_2, w0_4, differ)
- IF(differ)THEN
+ IF( .NOT.( w0_2 .REALEQ. w0_4) )THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
CALL H5Pclose_f(dapl2,error)
@@ -566,8 +563,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_3), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- CALL compare_floats(w0_3, w0_4, differ)
- IF(differ)THEN
+ IF( .NOT.( w0_3 .REALEQ. w0_4) )THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f4", .TRUE., .FALSE., total_error)
ENDIF
CALL H5Pclose_f(dapl2,error)
@@ -587,8 +583,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- CALL compare_floats(w0_2, w0_4, differ)
- IF(differ)THEN
+ IF( .NOT.( w0_2 .REALEQ. w0_4) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
CALL H5Pclose_f(dapl2,error)
@@ -608,8 +603,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- CALL compare_floats(w0_2, w0_4, differ)
- IF(differ)THEN
+ IF( .NOT.( w0_2 .REALEQ. w0_4) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
! Don't close dapl2, we will use it in the next section
@@ -646,8 +640,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_2), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- CALL compare_floats(w0_2, w0_4, differ)
- IF(differ)THEN
+ IF( .NOT.( w0_2 .REALEQ. w0_4) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
@@ -672,8 +665,7 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
CALL check("H5Pget_chunk_cache_f", error, total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nslots_3), INT(nslots_4), total_error)
CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error)
- CALL compare_floats(w0_3, w0_4, differ)
- IF(differ)THEN
+ IF( .NOT.( w0_3 .REALEQ. w0_4) ) THEN
CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
ENDIF
diff --git a/fortran/test/tH5P_F03.f90 b/fortran/test/tH5P_F03.f90
index 9f71a73..af8cad0 100644
--- a/fortran/test/tH5P_F03.f90
+++ b/fortran/test/tH5P_F03.f90
@@ -118,7 +118,6 @@ SUBROUTINE test_create(total_error)
INTEGER :: error
INTEGER(SIZE_T) :: h5off
TYPE(C_PTR) :: f_ptr
- LOGICAL :: differ1, differ2
!/*
! * Create a file.
@@ -205,20 +204,8 @@ SUBROUTINE test_create(total_error)
CALL H5Pget_fill_value_f(dcpl, comp_type_id, f_ptr, error)
CALL check("H5Pget_fill_value_f", error, total_error)
- differ1 = .FALSE.
- differ2 = .FALSE.
- if(abs(rd_c%a - fill_ctype%a) .ge. 1.D-08) then
- differ1 = .TRUE.
- endif
- ! This is a workaround; needs to be fixed
- !CALL compare_floats(rd_c%a, fill_ctype%a, differ1)
- if(abs(rd_c%y - fill_ctype%y) .ge. 1.D-08) then
- differ2 = .TRUE.
- endif
- ! This is a workaround; needs to be fixed
- !CALL compare_floats(rd_c%y, fill_ctype%y, differ2)
- IF( differ1 .OR. &
- differ2 .OR. &
+ IF( .NOT.(rd_c%a .REALEQ. fill_ctype%a) .OR. &
+ .NOT.(rd_c%y .REALEQ. fill_ctype%y) .OR. &
rd_c%x .NE. fill_ctype%x .OR. &
rd_c%z .NE. fill_ctype%z )THEN
diff --git a/fortran/test/tH5T.f90 b/fortran/test/tH5T.f90
index aac5f33..cb8e27c 100644
--- a/fortran/test/tH5T.f90
+++ b/fortran/test/tH5T.f90
@@ -112,7 +112,7 @@ CONTAINS
INTEGER(HID_T) :: decoded_tid1
INTEGER(HID_T) :: fixed_str1, fixed_str2
- LOGICAL :: are_equal, differ
+ LOGICAL :: are_equal
INTEGER(SIZE_T), PARAMETER :: str_size = 10
INTEGER(SIZE_T) :: query_size
@@ -528,13 +528,8 @@ CONTAINS
CALL h5dread_f(dset_id, dt3_id, double_member_out, data_dims, error)
CALL check("h5dread_f", error, total_error)
do i = 1, dimsize
- differ = .FALSE.
- if (abs(double_member_out(i) - double_member(i)) .ge. 1.D-08) THEN
- differ = .TRUE.
- endif
- ! This is temorary fix until we figure out how to compare floats
- !CALL compare_floats(double_member_out(i), double_member(i), differ)
- if (differ) then
+
+ IF( .NOT.(double_member_out(i) .REALEQ. double_member(i)) ) THEN
write(*,*) " Wrong double precision data is read back "
total_error = total_error + 1
endif
@@ -552,11 +547,10 @@ CONTAINS
CALL h5dread_f(dset_id, dt4_id, real_member_out, data_dims, error)
CALL check("h5dread_f", error, total_error)
do i = 1, dimsize
- 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
+ IF( .NOT.(real_member_out(i) .REALEQ. real_member(i) ) ) THEN
+ WRITE(*,*) " Wrong real precision data is read back "
+ total_error = total_error + 1
+ ENDIF
enddo
!
! *-----------------------------------------------------------------------
diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90
index bd6a701..f21f84a 100644
--- a/fortran/test/tH5T_F03.f90
+++ b/fortran/test/tH5T_F03.f90
@@ -90,7 +90,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
INTEGER :: error ! Generic RETURN value
INTEGER :: namelen
- LOGICAL :: flag, differ
+ LOGICAL :: flag
TYPE(C_PTR) :: f_ptr ! Needed to pass the pointer, for g95 compiler to work
@@ -258,8 +258,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(wdata(i,j)%f, rdata(i,j)%f, differ)
- IF(differ)THEN
+ IF( .NOT.( wdata(i,j)%f .REALEQ. rdata(i,j)%f) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -349,7 +348,6 @@ END SUBROUTINE test_array_compound_atomic
INTEGER(SIZE_T) :: attrlen ! Length of the attribute string
TYPE(c_ptr) :: f_ptr
- LOGICAL :: differ
! Initialize array data to write
DO i = 1, SPACE1_DIM1
@@ -622,8 +620,8 @@ END SUBROUTINE test_array_compound_atomic
total_error = total_error + 1
ENDIF
DO k = 1, ARRAY2_DIM1
- CALL compare_floats(wdata(i,j)%f(k), rdata(i,j)%f(k), differ)
- IF(differ)THEN
+
+ IF(wdata(i,j)%f(k).NE.rdata(i,j)%f(k))THEN
PRINT*, 'ERROR: Wrong real array data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -722,7 +720,6 @@ END SUBROUTINE test_array_compound_atomic
INTEGER :: error
TYPE(c_ptr) :: f_ptr
- LOGICAL :: differ
! Initialize the data
! -------------------
@@ -834,13 +831,12 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(cf(i)%b(j), cfr(i)%b(j), differ)
- IF(differ)THEN
+
+ IF( .NOT.(cf(i)%b(j) .REALEQ. cfr(i)%b(j) ) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ)
- IF(differ)THEN
+ IF( .NOT.(cf(i)%c(j) .REALEQ. cfr(i)%c(j) ) ) THEN
PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -903,8 +899,7 @@ END SUBROUTINE test_array_compound_atomic
DO i = 1, LENGTH
DO j = 1, ALEN
- CALL compare_floats(fld(i)%b(j), fldr(i)%b(j), differ)
- IF(differ)THEN
+ IF( .NOT.(fld(i)%b(j) .REALEQ. fldr(i)%b(j) ) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -935,13 +930,11 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(cf(i)%b(j), cfr(i)%b(j), differ)
- IF(differ)THEN
+ IF( .NOT.(cf(i)%b(j) .REALEQ. cfr(i)%b(j) ) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ)
- IF(differ)THEN
+ IF( .NOT.(cf(i)%c(j) .REALEQ. cfr(i)%c(j) ) ) THEN
PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -995,13 +988,11 @@ END SUBROUTINE test_array_compound_atomic
PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(cf(i)%b(j),cfr(i)%b(j), differ)
- IF(differ)THEN
+ IF( .NOT.(cf(i)%b(j) .REALEQ. cfr(i)%b(j) ) ) THEN
PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
- CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ)
- IF(differ)THEN
+ IF( .NOT.(cf(i)%c(j) .REALEQ. cfr(i)%c(j) ) ) THEN
PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f '
total_error = total_error + 1
ENDIF
@@ -3006,7 +2997,6 @@ SUBROUTINE test_nbit(total_error )
LOGICAL :: status
INTEGER(hsize_t) :: i, j
TYPE(C_PTR) :: f_ptr
- LOGICAL :: differ
! check to see if filter is available
CALL H5Zfilter_avail_f(H5Z_FILTER_NBIT_F, status, error)
@@ -3079,8 +3069,7 @@ SUBROUTINE test_nbit(total_error )
i_loop: DO i = 1, dims(1)
j_loop: DO j = 1, dims(2)
IF(.NOT.(orig_data(i,j).EQ.orig_data(i,j))) CYCLE ! skip IF value is NaN
- CALL compare_floats(new_data(i,j), orig_data(i,j), differ)
- IF(differ)THEN
+ IF( .NOT.(new_data(i,j) .REALEQ. orig_data(i,j) ) ) THEN
total_error = total_error + 1
WRITE(*,'(" Read different values than written.")')
WRITE(*,'(" At index ", 2(1X,I0))') i, j
diff --git a/fortran/test/tH5VL.f90 b/fortran/test/tH5VL.f90
index d34b42c..6803f59 100644
--- a/fortran/test/tH5VL.f90
+++ b/fortran/test/tH5VL.f90
@@ -226,7 +226,6 @@ CONTAINS
INTEGER(SIZE_T) max_len
INTEGER(HID_T) :: vl_type_id
LOGICAL :: vl_flag
- LOGICAL :: differ
!
! Initialize the vl_int_data array.
@@ -331,11 +330,10 @@ CONTAINS
CALL check("h5dread_real_f", error, total_error)
do ih = 1, data_dims(2)
do jh = 1, len_out(ih)
- CALL compare_floats(vl_real_data(jh,ih), vl_real_data_out(jh,ih), differ)
- if(differ) then
- total_error = total_error + 1
- write(*,*) "h5dread_vl_f returned incorrect data"
- endif
+ IF( .NOT.(vl_real_data(jh,ih) .REALEQ. vl_real_data_out(jh,ih)) ) THEN
+ total_error = total_error + 1
+ WRITE(*,*) "h5dread_vl_f returned incorrect data"
+ ENDIF
enddo
if (len(ih) .ne. len_out(ih)) then
total_error = total_error + 1
diff --git a/fortran/test/tf.f90 b/fortran/test/tf.f90
index cfa403a..78c7034 100644
--- a/fortran/test/tf.f90
+++ b/fortran/test/tf.f90
@@ -28,13 +28,63 @@
!
!*****
+! Define single, double and quadprecision
+
+MODULE h5_kinds
+ INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(6, 37)
+ INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(15, 307)
+ INTEGER, PARAMETER :: qp = SELECTED_REAL_KIND(33, 4931)
+END MODULE h5_kinds
+
+! Functions for Comparing two REAL numbers that
+! are quad, double and single precision.
+
+MODULE single_test_eqv
+ USE h5_kinds, ONLY: wp => sp
+ IMPLICIT NONE
+CONTAINS
+ INCLUDE 'tf_include.f90'
+END MODULE single_test_eqv
+
+MODULE double_test_eqv
+ USE h5_kinds, ONLY: wp => dp
+ IMPLICIT NONE
+CONTAINS
+ INCLUDE 'tf_include.f90'
+END MODULE double_test_eqv
+
+MODULE quad_test_eqv
+ USE h5_kinds, ONLY: wp => qp
+ IMPLICIT NONE
+CONTAINS
+ INCLUDE 'tf_include.f90'
+END MODULE quad_test_eqv
+
+! Interface operator for comparing reals
+
+MODULE generic_eqv
+
+ USE single_test_eqv, ONLY: test_eqv_1 => test_eqv
+ USE double_test_eqv, ONLY: test_eqv_2 => test_eqv
+ USE quad_test_eqv , ONLY: test_eqv_3 => test_eqv
+ IMPLICIT NONE
+ PRIVATE
+ PUBLIC OPERATOR(.realeq.)
+
+ INTERFACE OPERATOR(.realeq.)
+ MODULE PROCEDURE test_eqv_1, test_eqv_2, test_eqv_3
+ END INTERFACE
+
+END MODULE generic_eqv
+
MODULE TH5_MISC
+ USE generic_eqv
-INTERFACE compare_floats
- MODULE PROCEDURE compare_floats_4
- MODULE PROCEDURE compare_floats_8
-END INTERFACE
+ INTERFACE compare_floats
+ MODULE PROCEDURE compare_floats_4
+ MODULE PROCEDURE compare_floats_8
+ END INTERFACE
CONTAINS
diff --git a/fortran/test/tf_include.f90 b/fortran/test/tf_include.f90
new file mode 100644
index 0000000..bb7fd1b
--- /dev/null
+++ b/fortran/test/tf_include.f90
@@ -0,0 +1,37 @@
+!****h* root/fortran/test/tf_include.f90
+!
+! NAME
+! tf_include.f90
+!
+! FUNCTION
+! Contains overloaded operators for the hdf5 fortran tests, include in
+! tf.f90
+!
+! COPYRIGHT
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+! Copyright by The HDF Group. *
+! Copyright by the Board of Trustees of the University of Illinois. *
+! All rights reserved. *
+! *
+! This file is part of HDF5. The full HDF5 copyright notice, including *
+! terms governing use, modification, and redistribution, is contained in *
+! the files COPYING and Copyright.html. COPYING can be found at the root *
+! of the source code distribution tree; Copyright.html can be found at the *
+! root level of an installed copy of the electronic HDF5 document set and *
+! is linked from the top-level documents page. It can also be found at *
+! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have *
+! access to either file, you may request a copy from help@hdfgroup.org. *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
+! CONTAINS SUBROUTINES
+! test_eqv
+!
+!*****
+
+! Function for comparing two REAL(KIND=*) numbers.
+
+PURE FUNCTION test_eqv(a,b)
+ LOGICAL test_eqv
+ REAL(wp), INTENT (in):: a,b
+ test_eqv = ABS(a-b) .LT. 1.e-8
+END FUNCTION test_eqv
generated by cgit v0.12 at 2024-11-06 15:52:39 (GMT)