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

Tested on jam (gfortran, (-r8))

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

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
+     IF( .NOT.(aread_double_data(1) .REALEQ. 3.459_Fortran_DOUBLE) )THEN
-      differ = .TRUE.
+        WRITE(*,*) "Read back double attrbute is wrong", aread_double_data(1)
-     endif
+        total_error = total_error + 1
-     ! This is a temporary fix
+     ENDIF
-     !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)
-     CALL compare_floats(aread_real_data(1), 4.0, differ) 
+     
-     IF (differ) THEN
+     IF( .NOT.(aread_real_data(1) .REALEQ. REAL(4.0)) )THEN
-         WRITE(*,*) "Read back real attrbute is wrong ", aread_real_data
+        WRITE(*,*) "Read back real attrbute is wrong", aread_real_data(1)
-         total_error = total_error + 1
+        total_error = total_error + 1
-     END IF
+     ENDIF
      !
      !read the Integer attribute data back to memory
      !

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( .NOT.( w0_2 .REALEQ. w0_4) )THEN
-  IF(differ)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( .NOT.( w0_3 .REALEQ. w0_4) )THEN
-  IF(differ)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( .NOT.( w0_2 .REALEQ. w0_4) ) THEN
-  IF(differ)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( .NOT.( w0_2 .REALEQ. w0_4) ) THEN 
-  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
@@ -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( .NOT.( w0_2 .REALEQ. w0_4) ) THEN
-  IF(differ)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( .NOT.( w0_3 .REALEQ. w0_4) ) THEN
-  IF(differ)THEN
      CALL VERIFYlogical("H5Pget_chunk_cache_f", .TRUE., .FALSE., total_error)
   ENDIF
 

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.
+  IF( .NOT.(rd_c%a .REALEQ. fill_ctype%a) .OR. &
-  differ2 = .FALSE.
+      .NOT.(rd_c%y .REALEQ. fill_ctype%y) .OR. &
-  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
 

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
+            IF( .NOT.(double_member_out(i) .REALEQ. double_member(i)) ) 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
@@ -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( .NOT.(real_member_out(i) .REALEQ. real_member(i) ) ) THEN
-            if (differ) then
+               WRITE(*,*) " Wrong real precision data is read back "
-                write(*,*) " Wrong real precision data is read back "
+               total_error = total_error + 1
-                total_error = total_error + 1
+            ENDIF
-            endif
          enddo
      !
      ! *-----------------------------------------------------------------------

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( .NOT.( wdata(i,j)%f .REALEQ. rdata(i,j)%f) ) THEN
-        IF(differ)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( .NOT.(cf(i)%c(j) .REALEQ. cfr(i)%c(j) ) ) THEN
-          IF(differ)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( .NOT.(fld(i)%b(j) .REALEQ. fldr(i)%b(j) ) ) THEN
-          IF(differ)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( .NOT.(cf(i)%b(j) .REALEQ. cfr(i)%b(j) ) ) THEN
-          IF(differ)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( .NOT.(cf(i)%c(j) .REALEQ. cfr(i)%c(j) ) ) THEN
-          IF(differ)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( .NOT.(cf(i)%b(j) .REALEQ. cfr(i)%b(j) ) ) THEN
-          IF(differ)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( .NOT.(cf(i)%c(j) .REALEQ. cfr(i)%c(j) ) ) THEN
-          IF(differ)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( .NOT.(new_data(i,j) .REALEQ. orig_data(i,j) ) ) THEN
-        IF(differ)THEN
            total_error = total_error + 1
            WRITE(*,'("    Read different values than written.")')
            WRITE(*,'("    At index ", 2(1X,I0))') i, j

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( .NOT.(vl_real_data(jh,ih) .REALEQ. vl_real_data_out(jh,ih)) ) THEN 
-              if(differ)  then
+                    total_error = total_error + 1
-                  total_error = total_error + 1
+                    WRITE(*,*) "h5dread_vl_f returned incorrect data"
-                  write(*,*) "h5dread_vl_f returned incorrect data"
+                 ENDIF
-              endif
               enddo
                if (len(ih) .ne. len_out(ih)) then
                   total_error = total_error + 1

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
+  INTERFACE compare_floats
-   MODULE PROCEDURE compare_floats_4
+     MODULE PROCEDURE compare_floats_4
-   MODULE PROCEDURE compare_floats_8
+     MODULE PROCEDURE compare_floats_8
-END INTERFACE
+  END INTERFACE
 
 CONTAINS
 

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