mirror/hdf5
2
0
Fork 0
mirror of https://github.com/HDFGroup/hdf5.git synced 2025-03-31 17:10:47 +08:00
Code Issues Packages Projects Releases Wiki Activity

Updated the file locking Fortran property list wrappers and added

Browse Source 
a test.
This commit is contained in:
Dana Robinson 2020-08-03 18:43:19 -07:00
parent bd685b0e80
commit b2c90cc84e
5 changed files with 86 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
fortran/src/H5Pf.c
View File

@ -5241,83 +5241,6 @@ h5pget_file_image_c(hid_t_f *fapl_id, void **buf_ptr, size_t_f *buf_len_ptr)
return ret_value;
}
/****if* H5Pf/h5pset_file_locking_c
* NAME
* h5pset_file_locking_c
* PURPOSE
* Call H5Pset_file_locking to set file locking properties.
* INPUTS
* prp_id - file access property list identifier
* use_file_locking - TRUE/FALSE flag
* ignore_disabled_file_locking - TRUE/FALSE flag
* RETURNS
* 0 on success, -1 on failure
* AUTHOR
* Dana Robinson
* Summer 2020
* SOURCE
*/
int_f
h5pset_file_locking_c(hid_t_f *prp_id, int_f *use_file_locking, int_f *ignore_disabled_file_locking)
/******/
{
int ret_value = 0;
hid_t c_prp_id = H5I_INVALID_HID;
herr_t status;
hbool_t c_use_flag = 1;
hbool_t c_ignore_flag = 1;
if (*use_file_locking == 0) c_use_flag = 0;
if (*ignore_disabled_file_locking == 0) c_ignore_flag = 1;
c_prp_id = (hid_t)*prp_id;
status = H5Pset_file_locking(c_prp_id, c_use_flag, c_ignore_flag);
if ( status < 0 ) ret_value = -1;
return ret_value;
}
/****if* H5Pf/h5pget_file_locking_c
* NAME
* h5pget_file_locking_c
* PURPOSE
* Call H5Pget_file_locking to get file locking properties.
* INPUTS
* prp_id - file access property list identifier
* use_file_locking - TRUE/FALSE flag
* ignore_disabled_file_locking - TRUE/FALSE flag
* RETURNS
* 0 on success, -1 on failure
* AUTHOR
* Dana Robinson
* Summer 2020
* SOURCE
*/
int_f
h5pget_file_locking_c(hid_t_f *prp_id, int_f *use_file_locking, int_f *ignore_disabled_file_locking)
/******/
{
int ret_value = 0;
hid_t c_prp_id = H5I_INVALID_HID;
hbool_t c_use_flag = 1;
hbool_t c_ignore_flag = 1;
herr_t c_ret;
c_prp_id = (hid_t)*prp_id;
c_ret = H5Pget_file_locking(c_prp_id, &c_use_flag, &c_ignore_flag);
if ( c_ret < 0 ) ret_value = -1;
*use_file_locking = (int_f)c_use_flag;
*ignore_disabled_file_locking = (int_f)c_ignore_flag;
return ret_value;
}
#ifdef H5_HAVE_PARALLEL
/****if* H5Pf/h5pset_fapl_mpio_c
* NAME

16
fortran/src/H5Pff.F90
View File

@ -8298,16 +8298,16 @@ END SUBROUTINE h5pget_virtual_dsetname_f
LOGICAL(C_BOOL) :: c_ignore_flag
INTERFACE
INTEGER FUNCTION h5pget_file_locking_c(fapl_id, use_file_locking, ignore_disabled_locks) BIND(C, NAME='H5Pget_file_locking')
INTEGER FUNCTION h5pget_file_locking(fapl_id, use_file_locking, ignore_disabled_locks) BIND(C, NAME='H5Pget_file_locking')
IMPORT :: HID_T, C_BOOL
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN), VALUE :: fapl_id
LOGICAL(C_BOOL), INTENT(OUT) :: use_file_locking
LOGICAL(C_BOOL), INTENT(OUT) :: ignore_disabled_locks
END FUNCTION h5pget_file_locking_c
END FUNCTION h5pget_file_locking
END INTERFACE
hdferr = INT(h5pget_file_locking_c(fapl_id, c_use_flag, c_ignore_flag))
hdferr = INT(h5pget_file_locking(fapl_id, c_use_flag, c_ignore_flag))
! Transfer value of C C_BOOL type to Fortran LOGICAL
use_file_locking = c_use_flag
@ -8348,20 +8348,20 @@ END SUBROUTINE h5pget_virtual_dsetname_f
LOGICAL(C_BOOL) :: c_ignore_flag
INTERFACE
INTEGER FUNCTION h5pset_file_locking_c(fapl_id, use_file_locking, ignore_disabled_locks) BIND(C, NAME='H5Pset_file_locking')
INTEGER FUNCTION h5pset_file_locking(fapl_id, use_file_locking, ignore_disabled_locks) BIND(C, NAME='H5Pset_file_locking')
IMPORT :: HID_T, C_BOOL
IMPLICIT NONE
INTEGER(HID_T), INTENT(IN), VALUE :: fapl_id
LOGICAL(C_BOOL), INTENT(IN) :: use_file_locking
LOGICAL(C_BOOL), INTENT(IN) :: ignore_disabled_locks
END FUNCTION h5pset_file_locking_c
LOGICAL(C_BOOL), INTENT(IN), VALUE :: use_file_locking
LOGICAL(C_BOOL), INTENT(IN), VALUE :: ignore_disabled_locks
END FUNCTION h5pset_file_locking
END INTERFACE
! Transfer value of Fortran LOGICAL to C C_BOOL type
c_use_flag = use_file_locking
c_ignore_flag = ignore_disabled_locks
hdferr = INT(h5pset_file_locking_c(fapl_id, c_use_flag, c_ignore_flag))
hdferr = INT(h5pset_file_locking(fapl_id, c_use_flag, c_ignore_flag))
END SUBROUTINE h5pset_file_locking_f

2
fortran/src/H5f90proto.h
View File

@ -481,8 +481,6 @@ H5_FCDLL int_f h5pset_nlinks_c(hid_t_f *lapl_id, size_t_f *nlinks);
H5_FCDLL int_f h5pget_nlinks_c(hid_t_f *lapl_id, size_t_f *nlinks);
H5_FCDLL int_f h5pset_chunk_cache_c(hid_t_f *dapl_id, size_t_f *rdcc_nslots, size_t_f *rdcc_nbytes, real_f *rdcc_w0);
H5_FCDLL int_f h5pget_chunk_cache_c(hid_t_f *dapl_id, size_t_f *rdcc_nslots, size_t_f *rdcc_nbytes, real_f *rdcc_w0);
H5_FCDLL int_f h5pset_file_locking_c(hid_t_f *prp_id, int_f *use_file_locking, int_f *ignore_disabled_file_locking);
H5_FCDLL int_f h5pget_file_locking_c(hid_t_f *prp_id, int_f *use_file_locking, int_f *ignore_disabled_file_locking);
#ifdef H5_HAVE_PARALLEL
H5_FCDLL int_f h5pget_mpio_actual_io_mode_c(hid_t_f *dxpl_id, int_f *actual_io_mode);
H5_FCDLL int_f h5pget_fapl_mpio_c(hid_t_f *prp_id, int_f* comm, int_f* info);

6
fortran/test/fortranlib_test.F90
View File

@ -183,9 +183,13 @@ PROGRAM fortranlibtest
CALL write_test_status(ret_total_error, ' Multi file driver test', total_error)
ret_total_error = 0
CALL test_chunk_cache (cleanup, ret_total_error)
CALL test_chunk_cache(cleanup, ret_total_error)
CALL write_test_status(ret_total_error, ' Dataset chunk cache configuration', total_error)
ret_total_error = 0
CALL test_misc_properties(cleanup, ret_total_error)
CALL write_test_status(ret_total_error, ' Miscellaneous properties', total_error)
!
! '========================================='
! 'Testing ATTRIBUTE interface '

73
fortran/test/tH5P.F90
View File

@ -724,4 +724,77 @@ SUBROUTINE test_chunk_cache(cleanup, total_error)
END SUBROUTINE test_chunk_cache
!-------------------------------------------------------------------------
! Function: test_misc_properties
!
! Purpose: Tests setting and getting of miscellaneous properties. Does
! not test the underlying functionality as that is done in
! the C library tests.
!
! Tests APIs:
! H5P_GET/SET_FILE_LOCKING_F
!
! Return: Success: 0
! Failure: -1
!
!-------------------------------------------------------------------------
!
SUBROUTINE test_misc_properties(cleanup, total_error)
IMPLICIT NONE
LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(INOUT) :: total_error
INTEGER(hid_t) :: fapl_id = -1 ! Local fapl
LOGICAL :: use_file_locking ! (H5Pset/get_file_locking_f)
LOGICAL :: ignore_disabled_locks ! (H5Pset/get_file_locking_f)
INTEGER :: error
! Create a default fapl
CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl_id, error)
CALL check("H5Pcreate_f", error, total_error)
! Test H5Pset/get_file_locking_f
! true values
use_file_locking = .TRUE.
ignore_disabled_locks = .TRUE.
CALL h5pset_file_locking_f(fapl_id, use_file_locking, ignore_disabled_locks, error)
CALL check("h5pset_set_file_locking_f", error, total_error)
use_file_locking = .FALSE.
ignore_disabled_locks = .FALSE.
CALL h5pget_file_locking_f(fapl_id, use_file_locking, ignore_disabled_locks, error)
CALL check("h5pget_set_file_locking_f", error, total_error)
if(use_file_locking .neqv. .TRUE.) then
total_error = total_error + 1
write(*,*) "Got wrong use_file_locking flag from h5pget_file_locking_f"
endif
if(ignore_disabled_locks .neqv. .TRUE.) then
total_error = total_error + 1
write(*,*) "Got wrong ignore_disabled_locks flag from h5pget_file_locking_f"
endif
! false values
use_file_locking = .FALSE.
ignore_disabled_locks = .FALSE.
CALL h5pset_file_locking_f(fapl_id, use_file_locking, ignore_disabled_locks, error)
CALL check("h5pset_set_file_locking_f", error, total_error)
use_file_locking = .TRUE.
ignore_disabled_locks = .TRUE.
CALL h5pget_file_locking_f(fapl_id, use_file_locking, ignore_disabled_locks, error)
CALL check("h5pget_set_file_locking_f", error, total_error)
if(use_file_locking .neqv. .FALSE.) then
total_error = total_error + 1
write(*,*) "Got wrong use_file_locking flag from h5pget_file_locking_f"
endif
if(ignore_disabled_locks .neqv. .FALSE.) then
total_error = total_error + 1
write(*,*) "Got wrong ignore_disabled_locks flag from h5pget_file_locking_f"
endif
! Close the fapl
CALL H5Pclose_f(fapl_id, error)
CALL check("H5Pclose_f", error, total_error)
END SUBROUTINE test_misc_properties
END MODULE TH5P