From afb92a3e229a05755733c183d749bfc69548ab01 Mon Sep 17 00:00:00 2001 From: Scot Breitenfeld Date: Fri, 14 Oct 2022 13:35:52 -0500 Subject: Fix H5Dfill_f test (#2162) * change to integer for legacy H5Dfill_f testing * fixed H5Dfill testing issues with promoted real and integer * updated build fortran dependencies --- fortran/src/H5Dff.F90 | 17 +-- fortran/src/Makefile.am | 6 +- fortran/test/tH5D.F90 | 289 ++++++++++++++++++++++++++++------------------ fortran/test/tH5E_F03.F90 | 2 + 4 files changed, 188 insertions(+), 126 deletions(-) diff --git a/fortran/src/H5Dff.F90 b/fortran/src/H5Dff.F90 index 1a2c9f3..07d2508 100644 --- a/fortran/src/H5Dff.F90 +++ b/fortran/src/H5Dff.F90 @@ -88,6 +88,7 @@ MODULE H5D USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR, C_CHAR USE H5GLOBAL + USE H5LIB, ONLY : h5kind_to_type PRIVATE h5dread_vl_integer, h5dread_vl_real, h5dread_vl_string PRIVATE h5dwrite_vl_integer, h5dwrite_vl_real, h5dwrite_vl_string @@ -1659,8 +1660,8 @@ CONTAINS f_ptr_fill_value = C_LOC(fill_value) f_ptr_buf = C_LOC(buf(1)) - fill_type_id = H5T_NATIVE_INTEGER - mem_type_id = H5T_NATIVE_INTEGER + fill_type_id = h5kind_to_type(KIND(fill_value), H5_INTEGER_KIND) + mem_type_id = fill_type_id CALL h5dfill_ptr(f_ptr_fill_value, fill_type_id, f_ptr_buf, mem_type_id, space_id, hdferr) @@ -1683,8 +1684,8 @@ CONTAINS f_ptr_fill_value = C_LOC(fill_value) f_ptr_buf = C_LOC(buf(1)) - fill_type_id = H5T_NATIVE_REAL - mem_type_id = H5T_NATIVE_REAL + fill_type_id = h5kind_to_type(KIND(fill_value), H5_REAL_KIND) + mem_type_id = fill_type_id CALL h5dfill_ptr(f_ptr_fill_value, fill_type_id, f_ptr_buf, mem_type_id, space_id, hdferr) @@ -1706,8 +1707,8 @@ CONTAINS f_ptr_fill_value = C_LOC(fill_value) f_ptr_buf = C_LOC(buf(1)) - fill_type_id = H5T_NATIVE_DOUBLE - mem_type_id = H5T_NATIVE_DOUBLE + fill_type_id = h5kind_to_type(KIND(fill_value), H5_REAL_KIND) + mem_type_id = fill_type_id CALL h5dfill_ptr(f_ptr_fill_value, fill_type_id, f_ptr_buf, mem_type_id, space_id, hdferr) @@ -1730,8 +1731,8 @@ CONTAINS f_ptr_fill_value = C_LOC(fill_value) f_ptr_buf = C_LOC(buf(1)) - fill_type_id = H5T_NATIVE_DOUBLE - mem_type_id = H5T_NATIVE_DOUBLE + fill_type_id = h5kind_to_type(KIND(fill_value), H5_REAL_KIND) + mem_type_id = fill_type_id CALL h5dfill_ptr(f_ptr_fill_value, fill_type_id, f_ptr_buf, mem_type_id, space_id, hdferr) diff --git a/fortran/src/Makefile.am b/fortran/src/Makefile.am index 85e51b7..50aa5eb 100644 --- a/fortran/src/Makefile.am +++ b/fortran/src/Makefile.am @@ -41,8 +41,8 @@ else endif # Source files for the library. -libhdf5_fortran_la_SOURCES=H5f90global.F90 \ - H5fortran_types.F90 H5_ff.F90 H5Aff.F90 H5Dff.F90 H5Eff.F90 \ +libhdf5_fortran_la_SOURCES=H5fortran_types.F90 H5f90global.F90 \ + H5_ff.F90 H5Aff.F90 H5Dff.F90 H5Eff.F90 \ H5Fff.F90 H5Gff.F90 H5Iff.F90 H5Lff.F90 H5Off.F90 H5Pff.F90 H5Rff.F90 H5Sff.F90 \ H5Tff.F90 H5VLff.F90 H5Zff.F90 H5_gen.F90 H5fortkit.F90 \ H5f90kit.c H5_f.c H5Af.c H5Df.c H5Ef.c H5Ff.c H5Gf.c \ @@ -144,7 +144,7 @@ H5f90global.lo: $(srcdir)/H5f90global.F90 H5fortran_types.lo H5_buildiface.lo: $(srcdir)/H5_buildiface.F90 H5_ff.lo: $(srcdir)/H5_ff.F90 H5Fff.lo H5f90global.lo H5Aff.lo: $(srcdir)/H5Aff.F90 H5f90global.lo -H5Dff.lo: $(srcdir)/H5Dff.F90 H5f90global.lo +H5Dff.lo: $(srcdir)/H5Dff.F90 H5f90global.lo H5_ff.lo H5Eff.lo: $(srcdir)/H5Eff.F90 H5f90global.lo H5Fff.lo: $(srcdir)/H5Fff.F90 H5f90global.lo H5Gff.lo: $(srcdir)/H5Gff.F90 H5f90global.lo diff --git a/fortran/test/tH5D.F90 b/fortran/test/tH5D.F90 index 6e19ca4..001b6c2 100644 --- a/fortran/test/tH5D.F90 +++ b/fortran/test/tH5D.F90 @@ -31,6 +31,8 @@ ! !***** +#include + ! MODULE TH5D @@ -647,19 +649,25 @@ CONTAINS INTEGER(KIND=int_kind_16), DIMENSION(1:DIM0), TARGET :: data_i16 INTEGER(KIND=int_kind_1) , TARGET :: data0_i1 = 4 INTEGER(KIND=int_kind_4) , TARGET :: data0_i4 = 4 - INTEGER(KIND=int_kind_8) , TARGET :: data0_i8 = 4 INTEGER(KIND=int_kind_16), TARGET :: data0_i16 = 4 + INTEGER, DIMENSION(1:DIM0) :: data_int + INTEGER, TARGET :: data0_int = 4 #if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 INTEGER, PARAMETER :: int_kind_32 = SELECTED_INT_KIND(36) !should map to INTEGER*16 on most modern processors INTEGER(KIND=int_kind_32), DIMENSION(1:DIM0), TARGET :: data_i32 - INTEGER(KIND=int_kind_16), TARGET :: data0_i32 = 4 + INTEGER(KIND=int_kind_32), TARGET :: data0_i32 = 4 +#endif + INTEGER, PARAMETER :: real_kind_4 = C_FLOAT + INTEGER, PARAMETER :: real_kind_8 = C_DOUBLE + REAL(KIND=real_kind_4) , DIMENSION(1:DIM0), TARGET :: data_r4 + REAL(KIND=real_kind_8), DIMENSION(1:DIM0), TARGET :: data_r8 + REAL(KIND=real_kind_4) , TARGET :: data0_r4 = 4.0 + REAL(KIND=real_kind_8), TARGET :: data0_r8 = 4.0 +#if H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE!=0 + INTEGER, PARAMETER :: real_kind_16 = C_LONG_DOUBLE + REAL(KIND=real_kind_16) , DIMENSION(1:DIM0), TARGET :: data_r16 + REAL(KIND=real_kind_16) , TARGET :: data0_r16 = 4.0 #endif - INTEGER, PARAMETER :: real_kind_7 = C_FLOAT !should map to REAL*4 on most modern processors - INTEGER, PARAMETER :: real_kind_15 = C_DOUBLE !should map to REAL*8 on most modern processors - REAL(KIND=real_kind_7) , DIMENSION(1:DIM0), TARGET :: data_r7 - REAL(KIND=real_kind_15), DIMENSION(1:DIM0), TARGET :: data_r15 - REAL(KIND=real_kind_7) , TARGET :: data0_r7 = 4.0 - REAL(KIND=real_kind_15), TARGET :: data0_r15 = 4.0 INTEGER :: i CHARACTER , DIMENSION(1:DIM0), TARGET :: data_chr @@ -678,11 +686,15 @@ CONTAINS data_i4 = -2 data_i8 = -2 data_i16 = -2 + data_int = -2 #if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 data_i32 = -2 #endif - data_r7 = -2.0_real_kind_7 - data_r15 = -2.0_real_kind_15 + data_r4 = -2.0_real_kind_4 + data_r8 = -2.0_real_kind_8 +#if H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE!=0 + data_r16 = -2.0_real_kind_16 +#endif data_chr = "H" dims(1) = DIM0 @@ -699,66 +711,51 @@ CONTAINS ! TEST LEGACY H5Dfill_f APIs !********************************************************* - CALL h5dfill_f(data0_i8, space_id, data_i8, error) + CALL h5dfill_f(data0_int, space_id, data_int, error) CALL check("h5dfill_f", error, total_error) DO i = 1, DIM0 IF(i.LE. DIM0/2)THEN - CALL VERIFY("h5dfill_f", data0_i8, data_i8(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (I4)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + CALL VERIFY("h5dfill_f", data0_int, data_int(i), total_error) ELSE - CALL VERIFY("h5dfill_f", -2_int_kind_8, data_i8(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (I4)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + CALL VERIFY("h5dfill_f", -2, data_int(i), total_error) + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (INT)." + WRITE(*,'(A,I0)') " At index ",i + RETURN ENDIF ENDDO - CALL h5dfill_f(data0_r7, space_id, data_r7, error) + CALL h5dfill_f(data0_r4, space_id, data_r4, error) CALL check("h5dfill_f", error, total_error) DO i = 1, DIM0 IF(i.LE. DIM0/2)THEN - CALL VERIFY("h5dfill_f", data0_r7, data_r7(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (R4)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + CALL VERIFY("h5dfill_f", data0_r4, data_r4(i), total_error) ELSE - CALL VERIFY("h5dfill_f", -2.0_real_kind_7, data_r7(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (R4)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + CALL VERIFY("h5dfill_f", -2.0_real_kind_4, data_r4(i), total_error) + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (R4)." + WRITE(*,'(A,I0)') " At index ",i + RETURN ENDIF ENDDO - CALL h5dfill_f(data0_r15, space_id, data_r15, error) + CALL h5dfill_f(data0_r8, space_id, data_r8, error) CALL check("h5dfill_f", error, total_error) DO i = 1, DIM0 IF(i.LE. DIM0/2)THEN - CALL VERIFY("h5dfill_f", data0_r15, data_r15(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (R4)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + CALL VERIFY("h5dfill_f", data0_r8, data_r8(i), total_error) ELSE - CALL VERIFY("h5dfill_f", -2.0_real_kind_15, data_r15(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (R4)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + CALL VERIFY("h5dfill_f", -2.0_real_kind_8, data_r8(i), total_error) + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (R4)." + WRITE(*,'(A,I0)') " At index ",i + RETURN ENDIF ENDDO @@ -768,40 +765,29 @@ CONTAINS DO i = 1, DIM0 IF(i.LE. DIM0/2)THEN CALL VERIFY("h5dfill_f", data0_chr, data_chr(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (CHR)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF ELSE CALL VERIFY("h5dfill_f", "H", data_chr(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (CHR)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (CHR)." + WRITE(*,'(A,I0)') " At index ",i + RETURN ENDIF ENDDO #if H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE!=0 - CALL h5dfill_f(data0_i32, space_id, data_i32, error) + CALL h5dfill_f(data0_r16, space_id, data_r16, error) CALL check("h5dfill_f", error, total_error) - DO i = 1, DIM0 IF(i.LE. DIM0/2)THEN - CALL VERIFY("h5dfill_f", data0_i32, data_i32(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (I32)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + CALL VERIFY("h5dfill_f", data0_r16, data_r16(i), total_error) ELSE - CALL VERIFY("h5dfill_f", -2_int_kind_32, data_i32(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (I32)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + CALL VERIFY("h5dfill_f", -2.0_real_kind_16, data_r16(i), total_error) + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (R16)." + WRITE(*,'(A,I0)') " At index ",i + RETURN ENDIF ENDDO #endif @@ -818,8 +804,8 @@ CONTAINS #if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 data_i32 = -2 #endif - data_r7 = -2.0_real_kind_7 - data_r15 = -2.0_real_kind_15 + data_r4 = -2.0_real_kind_4 + data_r8 = -2.0_real_kind_8 data_chr = "H" ! Test spectrum of datatype types @@ -836,18 +822,13 @@ CONTAINS DO i = 1, DIM0 IF(i.LE. DIM0/2)THEN CALL VERIFY("h5dfill_f", data0_i1, data_i1(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (I1)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF ELSE CALL VERIFY("h5dfill_f", -2_int_kind_1, data_i1(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (I1)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I1)." + WRITE(*,'(A,I0)') " At index ",i + RETURN ENDIF ENDDO @@ -863,18 +844,13 @@ CONTAINS DO i = 1, DIM0 IF(i.LE. DIM0/2)THEN CALL VERIFY("h5dfill_f", data0_i4, data_i4(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (I4)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF ELSE CALL VERIFY("h5dfill_f", -2_int_kind_4, data_i4(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (I4)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I4)." + WRITE(*,'(A,I0)') " At index ",i + RETURN ENDIF ENDDO @@ -890,20 +866,108 @@ CONTAINS DO i = 1, DIM0 IF(i.LE. DIM0/2)THEN CALL VERIFY("h5dfill_f", data0_i16, data_i16(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (I16)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF ELSE CALL VERIFY("h5dfill_f", -2_int_kind_16, data_i16(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (I16)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I16)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDDO + +#if H5_HAVE_Fortran_INTEGER_SIZEOF_16!=0 + + f_ptr1 = C_LOC(data0_i32) + f_ptr2 = C_LOC(data_i32(1)) + + fill_type_id = h5kind_to_type(KIND(data0_i32), H5_INTEGER_KIND) + buf_type_id = fill_type_id + + CALL h5dfill_f(f_ptr1, fill_type_id, f_ptr2, buf_type_id, space_id, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_i32, data_i32(i), total_error) + ELSE + CALL VERIFY("h5dfill_f", -2_int_kind_32, data_i32(i), total_error) + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (I32)." + WRITE(*,'(A,I0)') " At index ",i + RETURN ENDIF ENDDO +#endif + + f_ptr1 = C_LOC(data0_r4) + f_ptr2 = C_LOC(data_r4(1)) + + fill_type_id = h5kind_to_type(KIND(data0_r4), H5_REAL_KIND) + buf_type_id = fill_type_id + + CALL h5dfill_f(f_ptr1, fill_type_id, f_ptr2, buf_type_id, space_id, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_r4, data_r4(i), total_error) + ELSE + CALL VERIFY("h5dfill_f", -2.0_real_kind_4, data_r4(i), total_error) + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (R4)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDDO + + f_ptr1 = C_LOC(data0_r8) + f_ptr2 = C_LOC(data_r8(1)) + + fill_type_id = h5kind_to_type(KIND(data0_r8), H5_REAL_KIND) + buf_type_id = fill_type_id + + CALL h5dfill_f(f_ptr1, fill_type_id, f_ptr2, buf_type_id, space_id, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_r8, data_r8(i), total_error) + ELSE + CALL VERIFY("h5dfill_f", -2.0_real_kind_8, data_r8(i), total_error) + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (R8)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDDO + +#if H5_FORTRAN_C_LONG_DOUBLE_IS_UNIQUE!=0 + f_ptr1 = C_LOC(data0_r16) + f_ptr2 = C_LOC(data_r16(1)) + + fill_type_id = h5kind_to_type(KIND(data0_r16), H5_REAL_KIND) + buf_type_id = fill_type_id + + CALL h5dfill_f(f_ptr1, fill_type_id, f_ptr2, buf_type_id, space_id, error) + CALL check("h5dfill_f", error, total_error) + + DO i = 1, DIM0 + IF(i.LE. DIM0/2)THEN + CALL VERIFY("h5dfill_f", data0_r16, data_r16(i), total_error) + ELSE + CALL VERIFY("h5dfill_f", -2.0_real_kind_16, data_r16(i), total_error) + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (R16)." + WRITE(*,'(A,I0)') " At index ",i + RETURN + ENDIF + ENDDO +#endif f_ptr1 = C_LOC(data0_chr) f_ptr2 = C_LOC(data_chr(1)) @@ -917,18 +981,13 @@ CONTAINS DO i = 1, DIM0 IF(i.LE. DIM0/2)THEN CALL VERIFY("h5dfill_f", data0_chr, data_chr(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (CHR)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF ELSE CALL VERIFY("h5dfill_f", "H", data_chr(i), total_error) - IF(total_error.NE.0)THEN - WRITE(*,'(A)') " Incorrect h5dfill value (CHR)." - WRITE(*,'(A,I0)') " At index ",i - RETURN - ENDIF + ENDIF + IF(total_error.NE.0)THEN + WRITE(*,'(A)') " Incorrect h5dfill value (CHR)." + WRITE(*,'(A,I0)') " At index ",i + RETURN ENDIF ENDDO diff --git a/fortran/test/tH5E_F03.F90 b/fortran/test/tH5E_F03.F90 index 35dde67..d0d1ef5 100644 --- a/fortran/test/tH5E_F03.F90 +++ b/fortran/test/tH5E_F03.F90 @@ -29,6 +29,8 @@ ! !***** +#include + ! ***************************************** ! *** H 5 E T E S T S ! ***************************************** -- cgit v0.12