xref: /llvm-project/offload/test/offloading/fortran/implicit-record-field-mapping.f90 (revision e532241b021cd48bad303721757c1194bc844775)
1! Test implicit mapping of alloctable record fields.
2
3! REQUIRES: flang, amdgpu
4
5! This fails only because it needs the Fortran runtime built for device. If this
6! is avaialbe, this test succeeds when run.
7! XFAIL: *
8
9! RUN: %libomptarget-compile-fortran-generic
10! RUN: env LIBOMPTARGET_INFO=16 %libomptarget-run-generic 2>&1 | %fcheck-generic
11program test_implicit_field_mapping
12  implicit none
13
14  type record_t
15    real, allocatable :: not_to_implicitly_map(:)
16    real, allocatable :: to_implicitly_map(:)
17  end type
18
19  type(record_t) :: dst_record
20  real :: src_array(10)
21  real :: dst_sum, src_sum
22  integer :: i
23
24  call random_number(src_array)
25  dst_sum = 0
26  src_sum = 0
27
28  do i=1,10
29    src_sum = src_sum + src_array(i)
30  end do
31  print *, "src_sum=", src_sum
32
33  !$omp target map(from: dst_sum)
34    dst_record%to_implicitly_map = src_array
35    dst_sum = 0
36
37    do i=1,10
38      dst_sum = dst_sum + dst_record%to_implicitly_map(i)
39    end do
40  !$omp end target
41
42  print *, "dst_sum=", dst_sum
43
44  if (src_sum == dst_sum) then
45    print *, "Test succeeded!"
46  else
47    print *, "Test failed!", " dst_sum=", dst_sum, "vs. src_sum=", src_sum
48  endif
49end program
50
51! CHECK: "PluginInterface" device {{[0-9]+}} info: Launching kernel {{.*}}
52! CHECK: Test succeeded!
53