openmp/libomptarget/test/offloading/fortran/target_map_common_block.f90

   1 ! Basic offloading test with a target region
   2 ! REQUIRES: flang, amdgcn-amd-amdhsa
   3 ! UNSUPPORTED: nvptx64-nvidia-cuda
   4 ! UNSUPPORTED: nvptx64-nvidia-cuda-LTO
   5 ! UNSUPPORTED: aarch64-unknown-linux-gnu
   6 ! UNSUPPORTED: aarch64-unknown-linux-gnu-LTO
   7 ! UNSUPPORTED: x86_64-pc-linux-gnu
   8 ! UNSUPPORTED: x86_64-pc-linux-gnu-LTO
   9
  10 ! RUN: %libomptarget-compile-fortran-run-and-check-generic
  11
  12 ! Testing simple variables in common block.
  13 program main
  14   call check_device
  15   call commonblock_simple_with_implicit_type
  16   call commonblock_simple_with_integer
  17   call commonblock_simple_with_real
  18 end program main
  19
  20 !-----
  21
  22 subroutine check_device
  23   use omp_lib
  24   integer :: devices(2)
  25   devices(1) = omp_get_device_num()
  26   !$omp target map(tofrom:devices)
  27     devices(2) = omp_get_device_num()
  28   !$omp end target
  29   print *, "devices: ", devices
  30 end subroutine check_device
  31
  32 !CHECK: devices: 1 0
  33
  34 !-----
  35
  36 subroutine commonblock_simple_with_implicit_type
  37   use omp_lib
  38   common var1
  39   var1 = 10
  40   print *, "var1 before target = ", var1
  41   !$omp target map(tofrom:var1)
  42     var1 = 20
  43   !$omp end target
  44   print *, "var1 after target = ", var1
  45 end subroutine
  46
  47 ! CHECK: var1 before target = 10
  48 ! CHECK: var1 after target = 20
  49
  50 ! -----
  51
  52 subroutine commonblock_simple_with_integer
  53   use omp_lib
  54   integer :: var2
  55   common var2
  56   var2 = 10
  57   print *, "var2 before target = ", var2
  58   !$omp target map(tofrom:var2)
  59     var2 = 20
  60   !$omp end target
  61   print *, "var2 after target = ", var2
  62 end subroutine
  63
  64 ! CHECK: var2 before target = 10
  65 ! CHECK: var2 after target = 20
  66
  67 ! -----
  68
  69 subroutine commonblock_simple_with_real
  70   use omp_lib
  71   real :: var3
  72   common var3
  73   var3 = 12.5
  74   print *, "var3 before target = ", var3
  75   !$omp target map(tofrom:var3)
  76     var3 = 14.5
  77   !$omp end target
  78   print *, "var3 after target = ", var3
  79 end subroutine
  80
  81 ! CHECK: var3 before target = 12.5
  82 ! CHECK: var3 after target = 14.5