brintos

brintos / llvm-project-archived public Read only

0
0
Text · 1.4 KiB · 9c52786 Raw
54 lines · plain
1! Offloading test checking lowering of arrays with dynamic extents.2! REQUIRES: flang, amdgpu3 4! RUN: %libomptarget-compile-fortran-run-and-check-generic5 6program test_openmp_mapper7   implicit none8   integer, parameter :: n = 10249   type :: mytype10      integer :: data(n)11   end type mytype12 13   type :: mytype214      type(mytype) :: my_data15   end type mytype216 17   ! Declare custom mappers for the derived type `mytype`18   !$omp declare mapper(my_mapper1 : mytype :: t) map(to: t%data(1 : n))19 20   ! Declare custom mappers for the derived type `mytype2`21   !$omp declare mapper(my_mapper2 : mytype2 :: t) map(mapper(my_mapper1): t%my_data)22 23   type(mytype2) :: obj24   integer :: i, sum_host, sum_device25 26   ! Initialize the host data27   do i = 1, n28      obj%my_data%data(i) = 129   end do30 31   ! Compute the sum on the host for verification32   sum_host = sum(obj%my_data%data)33 34   ! Offload computation to the device using the named mapper `my_mapper2`35   sum_device = 036   !$omp target map(tofrom: sum_device) map(mapper(my_mapper2) : obj)37   do i = 1, n38      sum_device = sum_device + obj%my_data%data(i)39   end do40   !$omp end target41 42   ! Check results43   print *, "Sum on host:    ", sum_host44   print *, "Sum on device:  ", sum_device45 46   if (sum_device == sum_host) then47      print *, "Test passed!"48   else49      print *, "Test failed!"50   end if51 end program test_openmp_mapper52 53! CHECK:  Test passed!54