51 lines · plain
1! Offloading test for the `target update` directive.2 3! REQUIRES: flang, amdgpu4 5! RUN: %libomptarget-compile-fortran-run-and-check-generic6program target_update7 implicit none8 integer :: x(1)9 integer :: host_id10 integer :: device_id(1)11 12 INTERFACE13 FUNCTION omp_get_device_num() BIND(C)14 USE, INTRINSIC :: iso_c_binding, ONLY: C_INT15 integer :: omp_get_device_num16 END FUNCTION omp_get_device_num17 END INTERFACE18 19 x(1) = 520 host_id = omp_get_device_num()21 22!$omp target enter data map(to:x, device_id)23!$omp target24 x(1) = 4225!$omp end target26 27 ! Test that without a `target update` directive, the target update to x is28 ! not yet seen by the host.29 ! CHECK: After first target regions and before target update: x = 530 print *, "After first target regions and before target update: x =", x(1)31 32!$omp target33 x(1) = 8434 device_id(1) = omp_get_device_num()35!$omp end target36!$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 = 8440 print *, "After second target regions and target update: x =", x(1)41 42 ! Make sure that offloading to the device actually happened. This way we43 ! verify that we didn't take the fallback host execution path.44 ! CHECK: Offloading succeeded!45 if (host_id /= device_id(1)) then46 print *, "Offloading succeeded!"47 else48 print *, "Offloading failed!"49 end if50end program target_update51