diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | fortran/test/tH5A.f90 | 29 | ||||
| -rw-r--r-- | fortran/test/tH5P.f90 | 24 | ||||
| -rw-r--r-- | fortran/test/tH5P_F03.f90 | 17 | ||||
| -rw-r--r-- | fortran/test/tH5T.f90 | 20 | ||||
| -rw-r--r-- | fortran/test/tH5T_F03.f90 | 37 | ||||
| -rw-r--r-- | fortran/test/tH5VL.f90 | 10 | ||||
| -rw-r--r-- | fortran/test/tf.f90 | 58 | ||||
| -rw-r--r-- | fortran/test/tf_include.f90 | 37 |
9 files changed, 96 insertions, 137 deletions
@@ -352,7 +352,6 @@ ./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 5ba2d62..b43707c 100644 --- a/fortran/test/tH5A.f90 +++ b/fortran/test/tH5A.f90 @@ -117,7 +117,7 @@ CONTAINS ! !general purpose integer ! - INTEGER :: i, j, wp + INTEGER :: i, j INTEGER :: error ! Error flag ! @@ -129,6 +129,8 @@ CONTAINS !data buffers ! INTEGER, DIMENSION(NX,NY) :: data_in + LOGICAL :: differ + ! !Initialize data_in buffer @@ -517,22 +519,27 @@ 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) - - 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 + 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 ! !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) - - 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 + 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 ! !read the Integer attribute data back to memory ! diff --git a/fortran/test/tH5P.f90 b/fortran/test/tH5P.f90 index 0ed12d2..454f507 100644 --- a/fortran/test/tH5P.f90 +++ b/fortran/test/tH5P.f90 @@ -450,6 +450,8 @@ 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 @@ -472,8 +474,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) - - IF( .NOT.( w0_1 .REALEQ. w0_4) )THEN + CALL compare_floats(w0_1, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF @@ -531,7 +533,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_2), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) - IF( .NOT.( w0_2 .REALEQ. w0_4) )THEN + CALL compare_floats(w0_2, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF CALL H5Pclose_f(dapl2,error) @@ -563,7 +566,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_3), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) - IF( .NOT.( w0_3 .REALEQ. w0_4) )THEN + CALL compare_floats(w0_3, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f4", .TRUE., .FALSE., total_error) ENDIF CALL H5Pclose_f(dapl2,error) @@ -583,7 +587,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_2), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) - IF( .NOT.( w0_2 .REALEQ. w0_4) ) THEN + CALL compare_floats(w0_2, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF CALL H5Pclose_f(dapl2,error) @@ -603,7 +608,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_2), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) - IF( .NOT.( w0_2 .REALEQ. w0_4) ) THEN + CALL compare_floats(w0_2, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF ! Don't close dapl2, we will use it in the next section @@ -640,7 +646,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_2), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) - IF( .NOT.( w0_2 .REALEQ. w0_4) ) THEN + CALL compare_floats(w0_2, w0_4, differ) + IF(differ)THEN CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error) ENDIF @@ -665,7 +672,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_3), INT(nslots_4), total_error) CALL VERIFY("H5Pget_chunk_cache_f", INT(nbytes_2), INT(nbytes_4), total_error) - IF( .NOT.( w0_3 .REALEQ. w0_4) ) THEN + CALL compare_floats(w0_3, w0_4, differ) + IF(differ)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 af8cad0..9f71a73 100644 --- a/fortran/test/tH5P_F03.f90 +++ b/fortran/test/tH5P_F03.f90 @@ -118,6 +118,7 @@ SUBROUTINE test_create(total_error) INTEGER :: error INTEGER(SIZE_T) :: h5off TYPE(C_PTR) :: f_ptr + LOGICAL :: differ1, differ2 !/* ! * Create a file. @@ -204,8 +205,20 @@ 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) - IF( .NOT.(rd_c%a .REALEQ. fill_ctype%a) .OR. & - .NOT.(rd_c%y .REALEQ. fill_ctype%y) .OR. & + 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. & 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 cb8e27c..aac5f33 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 + LOGICAL :: are_equal, differ INTEGER(SIZE_T), PARAMETER :: str_size = 10 INTEGER(SIZE_T) :: query_size @@ -528,8 +528,13 @@ 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 - - IF( .NOT.(double_member_out(i) .REALEQ. double_member(i)) ) THEN + 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 write(*,*) " Wrong double precision data is read back " total_error = total_error + 1 endif @@ -547,10 +552,11 @@ 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 - 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 + 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 enddo ! ! *----------------------------------------------------------------------- diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90 index f21f84a..bd6a701 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 + LOGICAL :: flag, differ TYPE(C_PTR) :: f_ptr ! Needed to pass the pointer, for g95 compiler to work @@ -258,7 +258,8 @@ SUBROUTINE test_array_compound_atomic(total_error) PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF( .NOT.( wdata(i,j)%f .REALEQ. rdata(i,j)%f) ) THEN + CALL compare_floats(wdata(i,j)%f, rdata(i,j)%f, differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF @@ -348,6 +349,7 @@ 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 @@ -620,8 +622,8 @@ END SUBROUTINE test_array_compound_atomic total_error = total_error + 1 ENDIF DO k = 1, ARRAY2_DIM1 - - IF(wdata(i,j)%f(k).NE.rdata(i,j)%f(k))THEN + CALL compare_floats(wdata(i,j)%f(k), rdata(i,j)%f(k), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong real array data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF @@ -720,6 +722,7 @@ END SUBROUTINE test_array_compound_atomic INTEGER :: error TYPE(c_ptr) :: f_ptr + LOGICAL :: differ ! Initialize the data ! ------------------- @@ -831,12 +834,13 @@ END SUBROUTINE test_array_compound_atomic PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - - IF( .NOT.(cf(i)%b(j) .REALEQ. cfr(i)%b(j) ) ) THEN + CALL compare_floats(cf(i)%b(j), cfr(i)%b(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF( .NOT.(cf(i)%c(j) .REALEQ. cfr(i)%c(j) ) ) THEN + CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF @@ -899,7 +903,8 @@ END SUBROUTINE test_array_compound_atomic DO i = 1, LENGTH DO j = 1, ALEN - IF( .NOT.(fld(i)%b(j) .REALEQ. fldr(i)%b(j) ) ) THEN + CALL compare_floats(fld(i)%b(j), fldr(i)%b(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF @@ -930,11 +935,13 @@ END SUBROUTINE test_array_compound_atomic PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF( .NOT.(cf(i)%b(j) .REALEQ. cfr(i)%b(j) ) ) THEN + CALL compare_floats(cf(i)%b(j), cfr(i)%b(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF( .NOT.(cf(i)%c(j) .REALEQ. cfr(i)%c(j) ) ) THEN + CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF @@ -988,11 +995,13 @@ END SUBROUTINE test_array_compound_atomic PRINT*, 'ERROR: Wrong integer data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF( .NOT.(cf(i)%b(j) .REALEQ. cfr(i)%b(j) ) ) THEN + CALL compare_floats(cf(i)%b(j),cfr(i)%b(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong real data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF - IF( .NOT.(cf(i)%c(j) .REALEQ. cfr(i)%c(j) ) ) THEN + CALL compare_floats(cf(i)%c(j), cfr(i)%c(j), differ) + IF(differ)THEN PRINT*, 'ERROR: Wrong double data is read back by H5Dread_f ' total_error = total_error + 1 ENDIF @@ -2997,6 +3006,7 @@ 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) @@ -3069,7 +3079,8 @@ 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 - IF( .NOT.(new_data(i,j) .REALEQ. orig_data(i,j) ) ) THEN + CALL compare_floats(new_data(i,j), orig_data(i,j), differ) + IF(differ)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 6803f59..d34b42c 100644 --- a/fortran/test/tH5VL.f90 +++ b/fortran/test/tH5VL.f90 @@ -226,6 +226,7 @@ CONTAINS INTEGER(SIZE_T) max_len INTEGER(HID_T) :: vl_type_id LOGICAL :: vl_flag + LOGICAL :: differ ! ! Initialize the vl_int_data array. @@ -330,10 +331,11 @@ CONTAINS CALL check("h5dread_real_f", error, total_error) do ih = 1, data_dims(2) do jh = 1, len_out(ih) - 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 + 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 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 78c7034..cfa403a 100644 --- a/fortran/test/tf.f90 +++ b/fortran/test/tf.f90 @@ -28,63 +28,13 @@ ! !***** -! 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 deleted file mode 100644 index bb7fd1b..0000000 --- a/fortran/test/tf_include.f90 +++ /dev/null @@ -1,37 +0,0 @@ -!****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 |