hdf5/fortran/test/vol_connector.F90

!****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
  IMPLICIT NONE

  INTEGER, PARAMETER :: NATIVE_VOL_CONNECTOR_VALUE = 0
  CHARACTER(LEN=6), PARAMETER :: NATIVE_VOL_CONNECTOR_NAME = "native"

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
    CHARACTER(LEN=6) :: name_exact
    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", 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 H5VLget_connector_name_f(file_id, name_exact, 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_exact, error)
    CALL check("H5VLget_connector_name_f",error,total_error)
    CALL VERIFY("H5VLget_connector_name_f", name_exact, NATIVE_VOL_CONNECTOR_NAME, 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)

    f_ptr = C_NULL_PTR
    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)

    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

  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."
  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