1! { dg-do run } 2! 3! Test if, if_present clauses on host_data construct. 4! 5! Fortran variant of 'libgomp.oacc-c-c++-common/host_data-7.c'. 6! 7program main 8 use iso_c_binding 9 implicit none 10 real, target :: var, arr(100) 11 integer(c_intptr_t) :: host_p, host_parr 12 host_p = transfer(c_loc(var), host_p) 13 host_parr = transfer(c_loc(arr), host_parr) 14 call foo (var, arr, host_p, host_parr, .false.) 15 call foo (var, arr, host_p, host_parr, .true.) 16 17contains 18 19subroutine foo (p2, parr, host_p, host_parr, cond) 20 use openacc 21 implicit none 22 real, target, intent(in) :: parr(:), p2 23 integer(c_intptr_t), value, intent(in) :: host_p, host_parr 24 logical, value, intent(in) :: cond 25 real, pointer :: p 26 p => p2 27 28 if (host_p /= transfer(c_loc(p), host_p)) stop 1 29 if (host_parr /= transfer(c_loc(parr), host_parr)) stop 2 30#if !ACC_MEM_SHARED 31 if (acc_is_present(p, c_sizeof(p))) stop 3 32 if (acc_is_present(parr, 1)) stop 4 33#endif 34 35 !$acc data copyin(host_p, host_parr) 36#if !ACC_MEM_SHARED 37 if (acc_is_present(p, c_sizeof(p))) stop 5 38 if (acc_is_present(parr, 1)) stop 6 39#endif 40 !$acc host_data use_device(p, parr) if_present 41 ! not mapped yet, so it will be equal to the host pointer. 42 if (transfer(c_loc(p), host_p) /= host_p) stop 7 43 if (transfer(c_loc(parr), host_parr) /= host_parr) stop 8 44 !$acc end host_data 45#if !ACC_MEM_SHARED 46 if (acc_is_present(p, c_sizeof(p))) stop 9 47 if (acc_is_present(parr, 1)) stop 10 48#endif 49 50 !$acc data copy(p, parr) 51 if (.not. acc_is_present(p, c_sizeof(p))) stop 11 52 if (.not. acc_is_present(parr, 1)) stop 12 53 ! Not inside a host_data construct, so still the host pointer. 54 if (transfer(c_loc(p), host_p) /= host_p) stop 13 55 if (transfer(c_loc(parr), host_parr) /= host_parr) stop 14 56 57 !$acc host_data use_device(p, parr) 58#if ACC_MEM_SHARED 59 if (transfer(c_loc(p), host_p) /= host_p) stop 15 60 if (transfer(c_loc(parr), host_parr) /= host_parr) stop 16 61#else 62 ! The device address is different from host address. 63 if (transfer(c_loc(p), host_p) == host_p) stop 17 64 if (transfer(c_loc(parr), host_parr) == host_parr) stop 18 65#endif 66 !$acc end host_data 67 68 !$acc host_data use_device(p, parr) if_present 69#if ACC_MEM_SHARED 70 if (transfer(c_loc(p), host_p) /= host_p) stop 19 71 if (transfer(c_loc(parr), host_parr) /= host_parr) stop 20 72#else 73 ! is present now, so this is the same as above. 74 if (transfer(c_loc(p), host_p) == host_p) stop 21 75 if (transfer(c_loc(parr), host_parr) == host_parr) stop 22 76#endif 77 !$acc end host_data 78 79 !$acc host_data use_device(p, parr) if(cond) 80#if ACC_MEM_SHARED 81 if (transfer(c_loc(p), host_p) /= host_p) stop 23 82 if (transfer(c_loc(parr), host_parr) /= host_parr) stop 24 83#else 84 ! is the device pointer iff cond is true. 85 if ((transfer(c_loc(p), host_p) /= host_p) .neqv. cond) stop 25 86 if ((transfer(c_loc(parr), host_parr) /= host_parr) .neqv. cond) stop 26 87#endif 88 !$acc end host_data 89 !$acc end data 90 !$acc end data 91end subroutine foo 92end 93