libgomp/testsuite/libgomp.oacc-fortran/acc_get_property.f90

! Test the `acc_get_property' and '`acc_get_property_string' library
! functions by printing the results of those functions for all devices
! of all device types mentioned in the OpenACC standard.
!
! See also acc_get_property.c

program test
  use openacc
  implicit none

  print *, "acc_device_none:"
  ! For completeness; not expected to print anything
  call print_device_properties (acc_device_none)

  print *, "acc_device_default:"
  call print_device_properties (acc_device_default)

  print *, "acc_device_host:"
  call print_device_properties (acc_device_host)

  print *, "acc_device_not_host:"
  call print_device_properties (acc_device_not_host)
end program test

! Print the values of the properties of all devices of the given type
! and do basic device independent validation.
subroutine print_device_properties (device_type)
  use openacc
  use iso_c_binding, only: c_size_t
  implicit none

  integer, intent(in) :: device_type

  integer :: device_count
  integer :: device
  integer(c_size_t) :: v
  character*256 :: s

  device_count = acc_get_num_devices(device_type)

  do device = 0, device_count - 1
     print "(a, i0)", "  Device ", device

     call acc_get_property_string (device, device_type, acc_property_vendor, s)
     print "(a, a)", "    Vendor: ", trim (s)
     if (s == "") then
        print *, "acc_property_vendor should not be empty."
        stop 1
     end if

     v = acc_get_property (device, device_type, acc_property_memory)
     print "(a, i0)", "    Total memory: ", v
     if (v < 0) then
        print *, "acc_property_memory should not be negative."
        stop 1
     end if

     v = acc_get_property (device, device_type, acc_property_free_memory)
     print "(a, i0)", "    Free memory: ", v
     if (v < 0) then
        print *, "acc_property_free_memory should not to be negative."
        stop 1
     end if

     v = acc_get_property (device, device_type, int(2360, kind = acc_device_property))
     if (v /= 0) then
        print *, "Value of unknown numeric property should be 0."
        stop 1
     end if

     call acc_get_property_string (device, device_type, acc_property_name, s)
     print "(a, a)", "    Name: ", trim (s)
     if (s == "") then
        print *, "acc_property_name should not be empty."
        stop 1
     end if

     call acc_get_property_string (device, device_type, acc_property_driver, s)
     print "(a, a)", "    Driver: ", trim (s)
     if (s == "") then
        print *, "acc_property_driver should not be empty."
        stop 1
     end if

     call acc_get_property_string (device, device_type, int(4060, kind = acc_device_property), s)
     if (s /= "") then
        print *, "Value of unknown string property should be empty string."
        stop 1
     end if

  end do
end subroutine print_device_properties