mirror/hdf5
2
0
Fork 0
mirror of https://github.com/HDFGroup/hdf5.git synced 2025-02-23 16:20:57 +08:00
Code Issues Packages Projects Releases Wiki Activity

[svn-r24984] Added overload operatorZ to compare REALs for tests.

Browse Source 
Tested on jam (gfortran, (-r8))
This commit is contained in:
Scot Breitenfeld 2014-04-07 19:18:20 -05:00
parent 67a61ed22f
commit ff9a10cfda
9 changed files with 137 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
MANIFEST
View File

@ -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

29
fortran/test/tH5A.f90
View File

@ -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
!

24
fortran/test/tH5P.f90
View File

@ -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

17
fortran/test/tH5P_F03.f90
View File

@ -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

20
fortran/test/tH5T.f90
View File

@ -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
!
! *-----------------------------------------------------------------------

37
fortran/test/tH5T_F03.f90
View File

@ -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

10
fortran/test/tH5VL.f90
View File

@ -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

58
fortran/test/tf.f90
View File

@ -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

37
fortran/test/tf_include.f90 Normal file
View File

@ -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