diff options
Diffstat (limited to 'fortran/test')
| -rw-r--r-- | fortran/test/Makefile.am | 2 | ||||
| -rw-r--r-- | fortran/test/tH5A_1_8.F90 | 5 | ||||
| -rw-r--r-- | fortran/test/tH5G_1_8.F90 | 162 | ||||
| -rw-r--r-- | fortran/test/tf.F90 | 86 |
4 files changed, 226 insertions, 29 deletions
diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am index 7d85a27..6ceddd6 100644 --- a/fortran/test/Makefile.am +++ b/fortran/test/Makefile.am @@ -47,7 +47,7 @@ fortranlib_test_1_8_SOURCES = tH5O.F90 tH5A_1_8.F90 tH5G_1_8.F90 tH5MISC_1_8.F90 fortranlib_test_1_8.F90 fortranlib_test_F03_SOURCES = tH5E_F03.F90 tH5F_F03.F90 tH5L_F03.F90 \ - tH5O_F03.F90 tH5P_F03.F90 tH5T_F03.F90 tHDF5_F03.F90 fortranlib_test_F03.F90 + tH5O_F03.F90 tH5P_F03.F90 tH5T_F03.F90 tHDF5_F03.F90 fortranlib_test_F03.F90 vol_connector_SOURCES=vol_connector.F90 diff --git a/fortran/test/tH5A_1_8.F90 b/fortran/test/tH5A_1_8.F90 index 5344f4b..d43279e 100644 --- a/fortran/test/tH5A_1_8.F90 +++ b/fortran/test/tH5A_1_8.F90 @@ -2614,6 +2614,7 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) WRITE(chr5,'(I5.5)') u attrname = 'attr '//chr5 CALL H5Aexists_f( gid, attrname, exists, error) + CALL check("H5Aexists_f", error, total_error) CALL verify("H5Aexists",exists,.FALSE.,total_error ) CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error, lapl_id = H5P_DEFAULT_F) @@ -2623,9 +2624,11 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) CALL check("h5acreate_f",error,total_error) CALL H5Aexists_f(gid, attrname, exists, error) + CALL check("H5Aexists_f", error, total_error) CALL verify("H5Aexists",exists,.TRUE.,total_error ) CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error) + CALL check("H5Aexists_by_name_f", error, total_error) CALL verify("H5Aexists_by_name_f",exists,.TRUE.,total_error ) attr_data1(1) = u @@ -2638,9 +2641,11 @@ SUBROUTINE test_attr_many(new_format, fcpl, fapl, total_error) CALL check("h5aclose_f",error,total_error) CALL H5Aexists_f(gid, attrname, exists, error) + CALL check("H5Aexists_f", error, total_error) CALL verify("H5Aexists",exists,.TRUE.,total_error ) CALL H5Aexists_by_name_f(fid, GROUP1_NAME, attrname, exists, error) + CALL check("H5Aexists_by_name_f", error, total_error) CALL verify("H5Aexists_by_name_f",exists,.TRUE.,total_error ) ENDDO diff --git a/fortran/test/tH5G_1_8.F90 b/fortran/test/tH5G_1_8.F90 index a4b25f2..c820d78 100644 --- a/fortran/test/tH5G_1_8.F90 +++ b/fortran/test/tH5G_1_8.F90 @@ -163,6 +163,7 @@ SUBROUTINE group_info(cleanup, fapl, total_error) ! H5G_STORAGE_TYPE_SYMBOL_TABLE: Symbol tables, the original HDF5 structure INTEGER :: nlinks ! Number of links in group INTEGER :: max_corder ! Current maximum creation order value for group + TYPE(H5G_info_t) :: ginfo INTEGER :: u,v ! Local index variables CHARACTER(LEN=2) :: chr2 @@ -283,29 +284,61 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL check("H5Gget_info_f", error, total_error) ! Check (new/empty) group's information - CALL verify("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) - CALL verify("H5Gget_info_f", max_corder, 0, total_error) - CALL verify("H5Gget_info_f", nlinks, 0, total_error) + CALL verify("H5Gget_info_f.storage_type", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL verify("H5Gget_info_f.max_corder", max_corder, 0, total_error) + CALL VERIFY("H5Gget_info_f.nlinks", nlinks, 0, total_error) CALL verify("H5Gget_info_f.mounted", mounted,.FALSE.,total_error) + ! Retrieve group's information (F03) + CALL H5Gget_info_f(group_id2, ginfo, error) + CALL check("H5Gget_info_f", error, total_error) + + CALL VERIFY("H5Gget_info_f.storage_type", & + ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F,C_INT), total_error) + CALL verify("H5Gget_info_f.max_corder", ginfo%max_corder, 0_C_INT64_T, total_error) + CALL verify("H5Gget_info_f.nlinks", ginfo%nlinks, 0_HSIZE_T, total_error) + CALL verify("H5Gget_info_f.mounted", LOGICAL(ginfo%mounted), .FALSE.,total_error) + ! Retrieve group's information CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error, mounted=mounted) CALL check("H5Gget_info_by_name_f", error, total_error) ! Check (new/empty) group's information - CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) - CALL verify("H5Gget_info_by_name_f", max_corder, 0, total_error) - CALL verify("H5Gget_info_by_name_f", nlinks, 0, total_error) - CALL verify("H5Gget_info_by_name_f.mounted", mounted,.FALSE.,total_error) + CALL verify("H5Gget_info_by_name_f.storage_type", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) + CALL verify("H5Gget_info_by_name_f.max_corder", max_corder, 0, total_error) + CALL verify("H5Gget_info_by_name_f.nlinks", nlinks, 0, total_error) + CALL verify("H5Gget_info_by_name_f.mounted", mounted, .FALSE., total_error) + + ! Retrieve group's information (F03) + CALL H5Gget_info_by_name_f(group_id, objname, ginfo, error) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! Check (new/empty) group's information + CALL VERIFY("H5Gget_info_by_name_f.storage_type", & + ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_by_name_f.max_corder", ginfo%max_corder, 0_C_INT64_T, total_error) + CALL verify("H5Gget_info_by_name_f.nlinks", ginfo%nlinks, 0_HSIZE_T, total_error) + CALL VERIFY("H5Gget_info_by_name_f.mounted", LOGICAL(ginfo%mounted), .FALSE.,total_error) ! Retrieve group's information CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name", error, total_error) ! Check (new/empty) group's information - CALL verify("H5Gget_info_by_name_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) - CALL verify("H5Gget_info_by_name_f", max_corder, 0, total_error) - CALL verify("H5Gget_info_by_name_f", nlinks, 0, total_error) + CALL VERIFY("H5Gget_info_by_name_f.storage_type", & + ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_by_name_f.max_corder", ginfo%max_corder, 0_C_INT64_T, total_error) + CALL verify("H5Gget_info_by_name_f.nlinks", ginfo%nlinks, 0_HSIZE_T, total_error) + + ! Retrieve group's information (F03) + CALL H5Gget_info_by_name_f(group_id2, ".", ginfo, error) + CALL check("H5Gget_info_by_name", error, total_error) + + ! Check (new/empty) group's information + CALL VERIFY("H5Gget_info_by_name_f.storage_type", & + ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_by_name_f.max_corder", ginfo%max_corder, 0_C_INT64_T, total_error) + CALL verify("H5Gget_info_by_name_f.nlinks", ginfo%nlinks, 0_HSIZE_T, total_error) ! Create objects in new group created DO v = 0, u @@ -331,6 +364,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_f", nlinks, u+1, total_error) + ! Retrieve group's information (F03) + CALL H5Gget_info_f(group_id2, ginfo, error) + CALL check("H5Gget_info_f", error, total_error) + + ! Check (new) group's information + CALL VERIFY("H5Gget_info_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL VERIFY("H5Gget_info_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL VERIFY("H5Gget_info_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) + ! Retrieve group's information CALL H5Gget_info_by_name_f(group_id, objname, storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name_f", error, total_error) @@ -340,6 +382,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_by_name_f",max_corder, u+1, total_error) CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error) + ! Retrieve group's information (F03) + CALL H5Gget_info_by_name_f(group_id, objname, ginfo, error) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! Check (new) group's information + CALL VERIFY("H5Gget_info_by_name_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL VERIFY("H5Gget_info_by_name_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL VERIFY("H5Gget_info_by_name_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) + ! Retrieve group's information CALL H5Gget_info_by_name_f(group_id2, ".", storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name_f", error, total_error) @@ -349,6 +400,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_by_name_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error) + ! Retrieve group's information (F03) + CALL H5Gget_info_by_name_f(group_id2, ".", ginfo, error) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! Check (new) group's information + CALL VERIFY("H5Gget_info_by_name_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL VERIFY("H5Gget_info_by_name_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL VERIFY("H5Gget_info_by_name_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) + ! Retrieve group's information IF(order.NE.H5_ITER_NATIVE_F)THEN IF(order.EQ.H5_ITER_INC_F) THEN @@ -356,16 +416,31 @@ SUBROUTINE group_info(cleanup, fapl, total_error) storage_type, nlinks, max_corder, error,lapl_id=H5P_DEFAULT_F, mounted=mounted) CALL check("H5Gget_info_by_idx_f", error, total_error) CALL verify("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error) + + CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(u,HSIZE_T), & + ginfo, error,lapl_id=H5P_DEFAULT_F) + CALL check("H5Gget_info_by_idx_f", error, total_error) + CALL VERIFY("H5Gget_info_by_idx_f", LOGICAL(ginfo%mounted), .FALSE., total_error) + ELSE CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(0,HSIZE_T), & storage_type, nlinks, max_corder, error, mounted=mounted) + CALL check("H5Gget_info_by_idx_f", error, total_error) CALL verify("H5Gget_info_by_idx_f", mounted,.FALSE.,total_error) + + CALL H5Gget_info_by_idx_f(group_id, ".", idx_type, order, INT(0,HSIZE_T), & + ginfo, error) CALL check("H5Gget_info_by_idx_f", error, total_error) + CALL verify("H5Gget_info_by_idx_f", LOGICAL(ginfo%mounted),.FALSE.,total_error) ENDIF ! Check (new) group's information CALL verify("H5Gget_info_by_idx_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL verify("H5Gget_info_by_idx_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_by_idx_f", nlinks, u+1, total_error) + + CALL VERIFY("H5Gget_info_by_idx_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_by_idx_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL verify("H5Gget_info_by_idx_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) ENDIF ! Close group created CALL H5Gclose_f(group_id2, error) @@ -380,6 +455,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_f", nlinks, u+1, total_error) + ! Retrieve main group's information (F03) + CALL H5Gget_info_f(group_id, ginfo, error) + CALL check("H5Gget_info_f", error, total_error) + + ! Check main group's information + CALL VERIFY("H5Gget_info_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL verify("H5Gget_info_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) + ! Retrieve main group's information, by name CALL H5Gget_info_by_name_f(file_id, CORDER_GROUP_NAME, storage_type, nlinks, max_corder, error) CALL check("H5Gget_info_by_name_f", error, total_error) @@ -389,6 +473,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_by_name_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error) + ! Retrieve main group's information, by name (F03) + CALL H5Gget_info_by_name_f(file_id, CORDER_GROUP_NAME, ginfo, error) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! Check main group's information + CALL VERIFY("H5Gget_info_by_name_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F,C_INT), total_error) + CALL verify("H5Gget_info_by_name_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL verify("H5Gget_info_by_name_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) + ! Retrieve main group's information, by name CALL H5Gget_info_by_name_f(group_id, ".", storage_type, nlinks, max_corder, error, H5P_DEFAULT_F) CALL check("H5Gget_info_by_name_f", error, total_error) @@ -398,6 +491,15 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_by_name_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_by_name_f", nlinks, u+1, total_error) + ! Retrieve main group's information, by name + CALL H5Gget_info_by_name_f(group_id, ".", ginfo, error, H5P_DEFAULT_F) + CALL check("H5Gget_info_by_name_f", error, total_error) + + ! Check main group's information + CALL VERIFY("H5Gget_info_by_name_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_by_name_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL verify("H5Gget_info_by_name_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) + ! Create soft link in another group, to objects in main group valname = CORDER_GROUP_NAME//objname @@ -411,31 +513,39 @@ SUBROUTINE group_info(cleanup, fapl, total_error) CALL verify("H5Gget_info_f", storage_type, H5G_STORAGE_TYPE_COMPACT_F, total_error) CALL verify("H5Gget_info_f", max_corder, u+1, total_error) CALL verify("H5Gget_info_f", nlinks, u+1, total_error) + + ! Retrieve soft link group's information, by name (F03) + CALL H5Gget_info_f(soft_group_id, ginfo, error) + CALL check("H5Gget_info_f", error, total_error) + + ! Check soft link group's information + CALL VERIFY("H5Gget_info_f", ginfo%storage_type, INT(H5G_STORAGE_TYPE_COMPACT_F, C_INT), total_error) + CALL verify("H5Gget_info_f", ginfo%max_corder, INT(u+1,C_INT64_T), total_error) + CALL verify("H5Gget_info_f", ginfo%nlinks, INT(u+1, HSIZE_T), total_error) ENDDO ! Close the groups - CALL H5Gclose_f(group_id, error) - CALL check("H5Gclose_f", error, total_error) - CALL H5Gclose_f(soft_group_id, error) - CALL check("H5Gclose_f", error, total_error) + CALL H5Gclose_f(group_id, error) + CALL check("H5Gclose_f", error, total_error) + CALL H5Gclose_f(soft_group_id, error) + CALL check("H5Gclose_f", error, total_error) - ! Close the file - CALL H5Fclose_f(file_id, error) - CALL check("H5Fclose_f", error, total_error) - ENDDO + ! Close the file + CALL H5Fclose_f(file_id, error) + CALL check("H5Fclose_f", error, total_error) ENDDO ENDDO + ENDDO - ! Free resources - CALL H5Pclose_f(gcpl_id, error) - CALL check("H5Pclose_f", error, total_error) - - IF(cleanup) CALL h5_cleanup_f(prefix, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) + ! Free resources + CALL H5Pclose_f(gcpl_id, error) + CALL check("H5Pclose_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f(prefix, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) - END SUBROUTINE group_info +END SUBROUTINE group_info !------------------------------------------------------------------------- ! * Function: timestamps @@ -1119,9 +1229,11 @@ SUBROUTINE lifecycle(cleanup, fapl2, total_error) CALL H5Lexists_f(file,"d1",Lexists, error) + CALL check("H5Lexists_f", error, total_error) CALL verify("H5Lexists", Lexists,.TRUE.,total_error) CALL H5Lexists_f(file,"grp1/hard",Lexists, error) + CALL check("H5Lexists_f", error, total_error) CALL verify("H5Lexists", Lexists,.TRUE.,total_error) ! Cleanup diff --git a/fortran/test/tf.F90 b/fortran/test/tf.F90 index 0c518f5..73f43bc 100644 --- a/fortran/test/tf.F90 +++ b/fortran/test/tf.F90 @@ -36,6 +36,8 @@ MODULE TH5_MISC INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(5) ! This should map to REAL*4 on most modern processors INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(10) ! This should map to REAL*8 on most modern processors + INTEGER, PARAMETER :: TAB_SPACE = 88 ! Tab spacing for printing results + ! generic compound datatype TYPE :: comp_datatype SEQUENCE @@ -57,6 +59,84 @@ CONTAINS !This definition is needed for Windows DLLs !DEC$if defined(BUILD_HDF5_TEST_DLL) +!DEC$attributes dllexport :: write_test_header +!DEC$endif + SUBROUTINE write_test_header(title_header) + + ! Writes the test header + + IMPLICIT NONE + + CHARACTER(LEN=*), INTENT(IN) :: title_header ! test name + INTEGER, PARAMETER :: width = TAB_SPACE+10 + CHARACTER(LEN=2*width) ::title_centered =" " + INTEGER :: len, i + + len=LEN_TRIM(title_header) + title_centered(1:3) ="| |" + title_centered((width-len)/2:(width-len)/2+len) = TRIM(title_header) + title_centered(width-1:width+2) ="| |" + + WRITE(*,'(1X)', ADVANCE="NO") + DO i = 1, width-1 + WRITE(*,'("_")', ADVANCE="NO") + ENDDO + WRITE(*,'()') + WRITE(*,'("| ")', ADVANCE="NO") + DO i = 1, width-5 + WRITE(*,'("_")', ADVANCE="NO") + ENDDO + WRITE(*,'(" |")') + + WRITE(*,'("| |")', ADVANCE="NO") + DO i = 1, width-5 + WRITE(*,'(1X)', ADVANCE="NO") + ENDDO + WRITE(*,'("| |")') + + WRITE(*,'(A)') title_centered + + WRITE(*,'("| |")', ADVANCE="NO") + DO i = 1, width-5 + WRITE(*,'(1X)', ADVANCE="NO") + ENDDO + WRITE(*,'("| |")') + + WRITE(*,'("| |")', ADVANCE="NO") + DO i = 1, width-5 + WRITE(*,'("_")', ADVANCE="NO") + ENDDO + WRITE(*,'("| |")') + + WRITE(*,'("|")', ADVANCE="NO") + DO i = 1, width-1 + WRITE(*,'("_")', ADVANCE="NO") + ENDDO + WRITE(*,'("|",/)') + + END SUBROUTINE write_test_header + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_TEST_DLL) +!DEC$attributes dllexport :: write_test_footer +!DEC$endif + SUBROUTINE write_test_footer() + + ! Writes the test footer + + IMPLICIT NONE + INTEGER, PARAMETER :: width = TAB_SPACE+10 + INTEGER :: i + + DO i = 1, width + WRITE(*,'("_")', ADVANCE="NO") + ENDDO + WRITE(*,'(/)') + + END SUBROUTINE write_test_footer + +!This definition is needed for Windows DLLs +!DEC$if defined(BUILD_HDF5_TEST_DLL) !DEC$attributes dllexport :: write_test_status !DEC$endif SUBROUTINE write_test_status( test_result, test_title, total_error) @@ -78,7 +158,7 @@ CONTAINS CHARACTER(LEN=8), PARAMETER :: success = ' PASSED ' CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*' CHARACTER(LEN=8), PARAMETER :: skip = '--SKIP--' - + CHARACTER(LEN=10) :: FMT error_string = failure IF (test_result == 0) THEN @@ -86,8 +166,8 @@ CONTAINS ELSE IF (test_result == -1) THEN error_string = skip ENDIF - - WRITE(*, fmt = '(A, T88, A)') test_title, error_string + WRITE(FMT,'("(A,T",I0,",A)")') TAB_SPACE + WRITE(*, fmt = FMT) test_title, error_string IF(test_result.GT.0) total_error = total_error + test_result |