diff options
Diffstat (limited to 'fortran/test/vol_connector.F90')
| -rw-r--r-- | fortran/test/vol_connector.F90 | 284 |
1 files changed, 284 insertions, 0 deletions
diff --git a/fortran/test/vol_connector.F90 b/fortran/test/vol_connector.F90 new file mode 100644 index 0000000..aabb2b8 --- /dev/null +++ b/fortran/test/vol_connector.F90 @@ -0,0 +1,284 @@ +!****h* root/fortran/test/vol_connector.F90 +! +! NAME +! vol_connector.F90 +! +! FUNCTION +! +! Tests basic Fortran VOL plugin operations (registration, etc.). +! Uses the null VOL connector (built with the testing code) +! which is loaded as a dynamic plugin. +! +! 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 COPYING file, which can be found at the root of the source code * +! distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases. * +! If you do not have access to either file, you may request a copy from * +! help@hdfgroup.org. * +! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * +! +!***** + +MODULE VOL_TMOD + + USE HDF5 + USE TH5_MISC + USE TH5_MISC_GEN + IMPLICIT NONE + + INTEGER, PARAMETER :: NATIVE_VOL_CONNECTOR_VALUE = 0 + CHARACTER(LEN=180) :: NATIVE_VOL_CONNECTOR_NAME + +CONTAINS + + !------------------------------------------------------------------------- + ! Function: test_registration_by_name() + ! + ! Purpose: Tests if we can load, register, and close a VOL + ! connector by name. + ! + !------------------------------------------------------------------------- + ! + + SUBROUTINE test_registration_by_name(total_error) + + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error = 0 + + LOGICAL :: is_registered = .FALSE. + INTEGER(hid_t) :: vol_id = 0, vol_id_out = 1 + CHARACTER(LEN=64) :: name + CHARACTER(LEN=1) :: name_null + INTEGER(SIZE_T) :: name_len + INTEGER(hid_t) :: file_id + + ! The null VOL connector should not be registered at the start of the test + CALL H5VLis_connector_registered_f( "FAKE_VOL_CONNECTOR_NAME", is_registered, error) + CALL check("H5VLis_connector_registered_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_f", is_registered, .FALSE., total_error) + + ! Register the connector by name + CALL H5VLregister_connector_by_name_f(NATIVE_VOL_CONNECTOR_NAME, vol_id, error) + CALL check("H5VLregister_connector_by_name_f",error,total_error) + + ! The connector should be registered now + CALL H5VLis_connector_registered_f(NATIVE_VOL_CONNECTOR_NAME, is_registered, error) + CALL check("H5VLis_connector_registered_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_f", is_registered, .TRUE., total_error) + + CALL H5VLget_connector_id_f(NATIVE_VOL_CONNECTOR_NAME, vol_id_out, error) + CALL check("H5VLget_connector_id_f",error,total_error) + + CALL H5Fcreate_f("voltest.h5",H5F_ACC_TRUNC_F, file_id, error) + CALL check("H5F_create_f",error,total_error) + + CALL H5VLget_connector_name_f(file_id, name, error, name_len) + CALL check("H5VLget_connector_name_f",error,total_error) + CALL VERIFY("H5VLget_connector_name_f", INT(name_len), LEN_TRIM(NATIVE_VOL_CONNECTOR_NAME), total_error) + + CALL H5VLget_connector_name_f(file_id, name, error) + CALL check("H5VLget_connector_name_f",error,total_error) + CALL VERIFY("H5VLget_connector_name_f", TRIM(name), NATIVE_VOL_CONNECTOR_NAME, total_error) + + CALL H5VLget_connector_name_f(file_id, name_null, error, name_len) + CALL check("H5VLget_connector_name_f",error,total_error) + CALL VERIFY("H5VLget_connector_name_f", INT(name_len), LEN_TRIM(NATIVE_VOL_CONNECTOR_NAME), total_error) + + CALL H5VLget_connector_name_f(file_id, name_null, error) + CALL check("H5VLget_connector_name_f",error,total_error) + CALL VERIFY("H5VLget_connector_name_f", name_null, NATIVE_VOL_CONNECTOR_NAME(1:1), total_error) + + CALL H5Fclose_f(file_id, error) + CALL check("H5Fclose_f",error,total_error) + + CALL H5VLclose_f(vol_id_out, error) + CALL check("H5VLclose_f",error, total_error) + + END SUBROUTINE test_registration_by_name + + !------------------------------------------------------------------------- + ! Function: test_registration_by_value() + ! + ! Purpose: Tests if we can load, register, and close a VOL + ! connector by value. + ! + !------------------------------------------------------------------------- + + SUBROUTINE test_registration_by_value(total_error) + + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error = 0 + + LOGICAL :: is_registered = .FALSE. + INTEGER(hid_t) :: vol_id = 0 + + + ! The null VOL connector should not be registered at the start of the test + CALL H5VLis_connector_registered_f( "FAKE_VOL_CONNECTOR_NAME", is_registered, error) + CALL check("H5VLis_connector_registered_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_f", is_registered, .FALSE., total_error) + + ! Register the connector by value + CALL H5VLregister_connector_by_value_f(NATIVE_VOL_CONNECTOR_VALUE, vol_id, error) + CALL check("H5VLregister_connector_by_value_f", error, total_error) + + ! The connector should be registered now + CALL H5VLis_connector_registered_f(NATIVE_VOL_CONNECTOR_NAME, is_registered, error) + CALL check("H5VLis_connector_registered_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_f", is_registered, .TRUE., total_error) + + END SUBROUTINE test_registration_by_value + + + !------------------------------------------------------------------------- + ! Function: test_registration_by_name() + ! + ! Purpose: Tests if we can load, register, and close a VOL + ! connector by name. + ! + !------------------------------------------------------------------------- + ! + + SUBROUTINE test_registration_by_fapl(total_error) + + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error = 0 + + LOGICAL :: is_registered = .FALSE. + INTEGER(hid_t) :: vol_id = 0, vol_id_out = 1 + INTEGER(hid_t) :: file_id + INTEGER(hid_t) :: fapl_id + TYPE(C_PTR) :: f_ptr + + CALL H5VLis_connector_registered_f( "FAKE_VOL_CONNECTOR_NAME", is_registered, error) + + CALL check("H5VLis_connector_registered_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_f", is_registered, .FALSE., total_error) + + ! The null VOL connector should not be registered at the start of the test + CALL H5VLis_connector_registered_f( "FAKE_VOL_CONNECTOR_NAME", is_registered, error) + CALL check("H5VLis_connector_registered_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_f", is_registered, .FALSE., total_error) + + CALL H5VLregister_connector_by_name_f(NATIVE_VOL_CONNECTOR_NAME, vol_id, error) + CALL check("H5VLregister_connector_by_name_f",error,total_error) + + ! The connector should be registered now + CALL H5VLis_connector_registered_f(NATIVE_VOL_CONNECTOR_NAME, is_registered, error) + CALL check("H5VLis_connector_registered_f",error,total_error) + CALL VERIFY("H5VLis_connector_registered_f", is_registered, .TRUE., total_error) + + ! Register the connector + CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl_id, error) + CALL check("H5Pcreate_f",error,total_error) + + IF(TRIM(NATIVE_VOL_CONNECTOR_NAME) .EQ. "native")THEN + CALL H5Pset_vol_f(fapl_id, vol_id, error) + CALL check("H5Pset_vol_f",error,total_error) + + CALL H5Pget_vol_id_f(fapl_id, vol_id_out, error) + CALL check("H5Pget_vol_id_f",error,total_error) + CALL VERIFY("H5Pget_vol_id_f", vol_id_out, vol_id, total_error) + + f_ptr = C_NULL_PTR + CALL H5Pset_vol_f(fapl_id, vol_id, error, f_ptr) + CALL check("H5Pset_vol_f",error,total_error) + + CALL H5Pget_vol_id_f(fapl_id, vol_id_out, error) + CALL check("H5Pget_vol_id_f",error,total_error) + CALL VERIFY("H5Pget_vol_id_f", vol_id_out, vol_id, total_error) + ENDIF + + CALL H5VLget_connector_id_f(NATIVE_VOL_CONNECTOR_NAME, vol_id_out, error) + CALL check("H5VLget_connector_id_f",error,total_error) + CALL VERIFY("H5VLget_connector_id_f", vol_id_out, vol_id, total_error) + CALL H5Fcreate_f("voltest.h5",H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl_id) + + CALL check("H5F_create_f",error,total_error) + + CALL H5VLclose_f(vol_id_out, error) + CALL check("H5VLclose_f",error, total_error) + + CALL H5VLclose_f(vol_id, error) + CALL check("H5VLclose_f",error, total_error) + + CALL H5Fclose_f(file_id, error) + CALL check("H5Fclose_f",error,total_error) + + CALL H5Pclose_f(fapl_id, error) + CALL check("H5Pclose_f",error,total_error) + + END SUBROUTINE test_registration_by_fapl + + +END MODULE VOL_TMOD + + +PROGRAM vol_connector + + USE HDF5 + USE VOL_TMOD + + IMPLICIT NONE + INTEGER :: total_error = 0 + INTEGER :: error + INTEGER :: ret_total_error + LOGICAL :: cleanup, status + CHARACTER(LEN=12) :: VOL_CONNECTOR_ENV + INTEGER :: LEN = 0 + + CALL h5open_f(error) + cleanup = .TRUE. + CALL h5_env_nocleanup_f(status) + IF(status) cleanup=.FALSE. + + WRITE(*,'(18X,A)') '==============================' + WRITE(*,'(24X,A)') 'FORTRAN VOL tests' + WRITE(*,'(18X,A)') '==============================' + + WRITE(*,'(A)') "Testing VOL connector plugin functionality." + + ! Check to see if the VOL connector was set with an env variable + CALL GET_ENVIRONMENT_VARIABLE("HDF5_VOL_CONNECTOR", VOL_CONNECTOR_ENV, LEN) + IF(LEN.NE.0)THEN + NATIVE_VOL_CONNECTOR_NAME = TRIM(VOL_CONNECTOR_ENV) + ELSE + NATIVE_VOL_CONNECTOR_NAME = "native" + ENDIF + + ret_total_error = 0 + CALL test_registration_by_name(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing VOL registration by name', total_error) + + ret_total_error = 0 + CALL test_registration_by_value(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing VOL registration by value', total_error) + + ret_total_error = 0 + CALL test_registration_by_fapl(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing VOL registration by fapl', total_error) + + WRITE(*, fmt = '(/18X,A)') '============================================' + WRITE(*, fmt = '(19X, A)', advance='NO') ' FORTRAN VOL tests completed with ' + WRITE(*, fmt = '(I4)', advance='NO') total_error + WRITE(*, fmt = '(A)' ) ' error(s) ! ' + WRITE(*,'(18X,A)') '============================================' + + CALL h5close_f(error) + + ! if errors detected, exit with non-zero code. + IF (total_error .NE. 0) CALL h5_exit_f(1) + +END PROGRAM vol_connector |