diff options
author | Scot Breitenfeld <brtnfld@hdfgroup.org> | 2024-01-23 15:59:10 (GMT) |
---|---|---|
committer | GitHub <noreply@github.com> | 2024-01-23 15:59:10 (GMT) |
commit | 54fb80938256f565210d4c22b3021d6b96d0f56a (patch) | |
tree | 5505902a82af9699b5adbd54ff9870e95b2ff207 /fortran/test | |
parent | 51f150a94590f3b495d32c44f6d507eb5a7565a0 (diff) | |
download | hdf5-54fb80938256f565210d4c22b3021d6b96d0f56a.zip hdf5-54fb80938256f565210d4c22b3021d6b96d0f56a.tar.gz hdf5-54fb80938256f565210d4c22b3021d6b96d0f56a.tar.bz2 |
Fortran API work. (#3941)
* - Added Fortran APIs:
H5FGET_INTENT_F, H5SSELECT_ITER_CREATE_F, H5SSEL_ITER_GET_SEQ_LIST_F,
H5SSELECT_ITER_CLOSE_F, H5S_mp_H5SSELECT_ITER_RESET_F
- Added Fortran Parameters:
H5S_SEL_ITER_GET_SEQ_LIST_SORTED_F, H5S_SEL_ITER_SHARE_WITH_DATASPACE_F
- Added tests for new APIs
- Removed H5F C wrapper stubs
- Documentation misc. cleanup.
Diffstat (limited to 'fortran/test')
-rw-r--r-- | fortran/test/fortranlib_test.F90 | 8 | ||||
-rw-r--r-- | fortran/test/tH5F.F90 | 13 | ||||
-rw-r--r-- | fortran/test/tH5Sselect.F90 | 149 |
3 files changed, 161 insertions, 9 deletions
diff --git a/fortran/test/fortranlib_test.F90 b/fortran/test/fortranlib_test.F90 index e0a837a..05ae593 100644 --- a/fortran/test/fortranlib_test.F90 +++ b/fortran/test/fortranlib_test.F90 @@ -158,9 +158,8 @@ PROGRAM fortranlibtest CALL test_basic_select(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Basic selection test', total_error) - ret_total_error = 0 - CALL test_select_hyperslab( cleanup, ret_total_error) + CALL test_select_hyperslab(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Hyperslab selection test', total_error) ret_total_error = 0 @@ -179,6 +178,11 @@ PROGRAM fortranlibtest CALL test_select_bounds(ret_total_error) CALL write_test_status(ret_total_error, ' Selection bounds test ', total_error) + ret_total_error = 0 + CALL test_select_iter(cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' Dataspace selection iterators test', total_error) + + ! ! '=========================================' ! 'Testing DATATYPE interface ' diff --git a/fortran/test/tH5F.F90 b/fortran/test/tH5F.F90 index 7f9490b..569d459 100644 --- a/fortran/test/tH5F.F90 +++ b/fortran/test/tH5F.F90 @@ -197,6 +197,7 @@ CONTAINS !flag to check operation success ! INTEGER :: error + INTEGER :: fintent ! !general purpose integer @@ -215,8 +216,8 @@ CONTAINS !data buffers ! INTEGER, DIMENSION(NX,NY) :: data_in, data_out - INTEGER(HSIZE_T), DIMENSION(2) :: data_dims + filename1 = "mount1" filename2 = "mount2" @@ -377,6 +378,13 @@ CONTAINS CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) CALL check("hfopen_f",error,total_error) + CALL h5fget_intent_f(file1_id, fintent, error) + CALL check("h5fget_intent_f",error,total_error) + + IF(fintent.NE.H5F_ACC_RDWR_F)THEN + total_error = total_error + 1 + ENDIF + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) CALL check(" h5fget_obj_count_f",error,total_error) @@ -389,7 +397,6 @@ CONTAINS CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) CALL check(" h5fget_obj_count_f",error,total_error) - IF(obj_count.NE.2)THEN total_error = total_error + 1 ENDIF @@ -1038,7 +1045,7 @@ CONTAINS total_error = total_error + 1 write(*,*) " Open with H5F_CLOSE_STRONG should fail " endif - + CALL h5fget_obj_count_f(fid1, H5F_OBJ_ALL_F, obj_count, error) CALL check("h5fget_obj_count_f",error,total_error) if(error .eq.0 .and. obj_count .ne. 3) then diff --git a/fortran/test/tH5Sselect.F90 b/fortran/test/tH5Sselect.F90 index b6d28d3..7b3a066 100644 --- a/fortran/test/tH5Sselect.F90 +++ b/fortran/test/tH5Sselect.F90 @@ -314,7 +314,151 @@ CONTAINS END SUBROUTINE test_select_hyperslab ! - !Subroutine to test element selection + ! Subroutine to test selection iterations + ! + + SUBROUTINE test_select_iter(cleanup, total_error) + + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + INTEGER, PARAMETER :: POINT1_NPOINTS = 10 + INTEGER(SIZE_T), PARAMETER :: SEL_ITER_MAX_SEQ = 256 ! Information for testing selection iterators + INTEGER, PARAMETER :: rank = 2 + INTEGER(SIZE_T), PARAMETER :: NUMP = 4 + + INTEGER(hsize_t), DIMENSION(2) :: dims1 = (/12, 6/) ! 2-D Dataspace dimensions + INTEGER(HID_T) :: sid ! Dataspace ID + INTEGER(HID_T) :: iter_id ! Dataspace selection iterator ID + INTEGER(HSIZE_T), DIMENSION(rank, POINT1_NPOINTS) :: coord1 ! Coordinates for point selection + INTEGER(HSIZE_T), DIMENSION(2) :: start ! Hyperslab start + INTEGER(HSIZE_T), DIMENSION(2) :: stride ! Hyperslab stride + INTEGER(HSIZE_T), DIMENSION(2) :: count ! Hyperslab block count + INTEGER(HSIZE_T), DIMENSION(2) :: BLOCK ! Hyperslab block size + INTEGER(SIZE_T) :: nseq ! # of sequences retrieved + INTEGER(SIZE_T) :: nbytes ! # of bytes retrieved + INTEGER(HSIZE_T), DIMENSION(SEL_ITER_MAX_SEQ) :: off ! Offsets for retrieved sequences + INTEGER(SIZE_T), DIMENSION(SEL_ITER_MAX_SEQ) :: ilen ! Lengths for retrieved sequences + INTEGER :: sel_type ! Selection type + INTEGER :: error ! Error return value + integer(size_t) :: i + + ! Create dataspace + CALL H5Screate_simple_f(2, dims1, sid, error) + CALL check("H5Screate_simple_f", error, total_error) + + ! Test iterators on various basic selection types + DO sel_type = H5S_SEL_NONE_F, H5S_SEL_ALL_F + IF(sel_type .EQ. H5S_SEL_NONE_F)THEN ! "None" selection + CALL H5Sselect_none_f(sid, error) + CALL check("H5Sselect_none_f", error, total_error) + ELSE IF(sel_type.EQ.H5S_SEL_POINTS_F)THEN ! Point selection + ! Select sequence of four points + coord1(1, 1) = 1 + coord1(2, 1) = 2 + coord1(1, 2) = 3 + coord1(2, 2) = 4 + coord1(1, 3) = 5 + coord1(2, 3) = 6 + coord1(1, 4) = 7 + coord1(2, 4) = 8 + CALL H5Sselect_elements_f(sid, H5S_SELECT_SET_F, rank, NUMP, coord1, error) + CALL check("H5Sselect_elements_f", error, total_error) + ELSE IF(sel_type.EQ.H5S_SEL_HYPERSLABS_F)THEN ! Hyperslab selection + ! Select regular hyperslab + start(1) = 0 + start(2) = 0 + stride(1) = 1 + stride(2) = 1 + COUNT(1) = 4 + COUNT(2) = 4 + BLOCK(1) = 1 + BLOCK(2) = 1 + CALL H5Sselect_hyperslab_f(sid, H5S_SELECT_SET_F, start, count, error, stride=stride, BLOCK=BLOCK) + CALL check("H5Sselect_hyperslab_f", error, total_error) + ELSE IF(sel_type.EQ.H5S_SEL_ALL_F)THEN ! "All" selection + CALL H5Sselect_all_f(sid, error) + CALL check("H5Sselect_all_f", error, total_error) + ELSE + CALL check("Incorrect selection option", error, total_error) + ENDIF + + ! Create selection iterator object + CALL H5Ssel_iter_create_f(sid, 1_size_t, H5S_SEL_ITER_SHARE_WITH_DATASPACE_F, iter_id, error) + CALL check("H5Ssel_iter_create_f", error, total_error) + + ! Try retrieving all sequence + off = -99 + ilen = -99 + CALL H5Ssel_iter_get_seq_list_f(iter_id, SEL_ITER_MAX_SEQ, 1024_size_t * 1024_size_t, nseq, nbytes, off, ilen, error) + CALL check("H5Ssel_iter_get_seq_list_f", error, total_error) + + ! Check results from retrieving sequence list + + IF (sel_type .EQ. H5S_SEL_NONE_F)THEN ! "None" selection + CALL VERIFY("H5Ssel_iter_get_seq_list_f", nseq, INT(0,SIZE_T), total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", nbytes, INT(0,SIZE_T), total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(1), INT(-99,HSIZE_T), total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(1), INT(-99,SIZE_T), total_error) + ELSE IF (sel_type .EQ. H5S_SEL_POINTS_F)THEN ! Point selection + CALL VERIFY("H5Ssel_iter_get_seq_list_f", nseq, 4_SIZE_T, total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", nbytes, 4_SIZE_T, total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(NUMP+1), INT(-99,HSIZE_T), total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(NUMP+1), INT(-99,HSIZE_T), total_error) + DO i = 1, NUMP + CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(i), INT((i-1)*26+12,HSIZE_T), total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(i), INT(1,SIZE_T), total_error) + ENDDO + ELSE IF (sel_type .eq. H5S_SEL_HYPERSLABS_F)THEN ! Hyperslab selection + CALL VERIFY("H5Ssel_iter_get_seq_list_f", nseq, 4_SIZE_T, total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", nbytes, 16_SIZE_T, total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(NUMP+1), INT(-99,HSIZE_T), total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(NUMP+1), INT(-99,HSIZE_T), total_error) + DO i = 1, NUMP + CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(i), INT((i-1)*12,HSIZE_T), total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(i), INT(4,SIZE_T), total_error) + ENDDO + ELSE IF (sel_type.EQ.H5S_SEL_ALL_F)THEN ! "All" selection + CALL VERIFY("H5Ssel_iter_get_seq_list_f", nseq, 1_SIZE_T, total_error ) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", nbytes, 72_SIZE_T, total_error ) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(1), INT(0,HSIZE_T), total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(1), INT(72,HSIZE_T), total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", off(2), INT(-99,HSIZE_T), total_error) + CALL VERIFY("H5Ssel_iter_get_seq_list_f", ilen(2), INT(-99,HSIZE_T), total_error) + ELSE + CALL check("Incorrect selection option", error, total_error) + ENDIF + + ! Reset iterator + !CALL H5Ssel_iter_reset_f(iter_id, sid, error) + !CALL check("H5Ssel_iter_reset_f", error, total_error) + + !off = -99 + !ilen = -99 + !CALL H5Ssel_iter_get_seq_list_f(iter_id, SEL_ITER_MAX_SEQ, 1024_size_t * 1024_size_t, nseq, nbytes, off, ilen, error) + !CALL check("H5Ssel_iter_get_seq_list_f", error, total_error) + + ! Close selection iterator + CALL H5Ssel_iter_close_f(iter_id, error) + CALL check("H5Ssel_iter_close_f", error, total_error) + END DO + + ! Create selection iterator object + CALL H5Ssel_iter_create_f(sid, 1_size_t, H5S_SEL_ITER_GET_SEQ_LIST_SORTED_F, iter_id, error) + CALL check("H5Ssel_iter_create_f", error, total_error) + + ! Reset iterator + CALL H5Ssel_iter_reset_f(iter_id, sid, error) + CALL check("H5Ssel_iter_reset_f", error, total_error) + + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f", error, total_error) + + END SUBROUTINE test_select_iter + + ! + ! Subroutine to test element selection ! SUBROUTINE test_select_element(cleanup, total_error) @@ -1043,9 +1187,6 @@ CONTAINS ! DEALLOCATE(pointlist) - - - ! !Close the dataspace for the dataset. ! |