1! Offloading test for the `target update` directive. 2 3! REQUIRES: flang, amdgpu 4 5! RUN: %libomptarget-compile-fortran-run-and-check-generic 6program target_update 7 implicit none 8 integer :: x(1) 9 integer :: host_id 10 integer :: device_id(1) 11 12 INTERFACE 13 FUNCTION omp_get_device_num() BIND(C) 14 USE, INTRINSIC :: iso_c_binding, ONLY: C_INT 15 integer :: omp_get_device_num 16 END FUNCTION omp_get_device_num 17 END INTERFACE 18 19 x(1) = 5 20 host_id = omp_get_device_num() 21 22!$omp target enter data map(to:x, device_id) 23!$omp target 24 x(1) = 42 25!$omp end target 26 27 ! Test that without a `target update` directive, the target update to x is 28 ! not yet seen by the host. 29 ! CHECK: After first target regions and before target update: x = 5 30 print *, "After first target regions and before target update: x =", x(1) 31 32!$omp target 33 x(1) = 84 34 device_id(1) = omp_get_device_num() 35!$omp end target 36!$omp target update from(x, device_id) 37 38 ! Test that after the `target update`, the host can see the new x value. 39 ! CHECK: After second target regions and target update: x = 84 40 print *, "After second target regions and target update: x =", x(1) 41 42 ! Make sure that offloading to the device actually happened. This way we 43 ! verify that we didn't take the fallback host execution path. 44 ! CHECK: Offloading succeeded! 45 if (host_id /= device_id(1)) then 46 print *, "Offloading succeeded!" 47 else 48 print *, "Offloading failed!" 49 end if 50end program target_update 51