1! { dg-do run } 2! { dg-xfail-run-if "PR92790 - acc declare device_resident - Fortran common blocks not handled" { *-*-* } { "*" } { "-DACC_DEVICE_TYPE_host=1" } } 3 4module vars 5 implicit none 6 real b 7 !$acc declare device_resident (b) 8 9 integer :: x, y, z 10 common /block/ x, y, z 11 !$acc declare device_resident (/block/) 12end module vars 13 14subroutine set() 15 use openacc 16 implicit none 17 integer :: a(5), b(1), c, vals(7) 18 common /another/ a, b, c 19 !$acc declare device_resident (/another/) 20 if (.not. acc_is_present (a)) stop 10 21 if (.not. acc_is_present (b)) stop 11 22 if (.not. acc_is_present (c)) stop 12 23 24 vals = 99 25 ! NOTE: The current (Nov 2019) implementation requires the 'present' 26 ! as it tries to otherwises map the device_resident variables; 27 ! following OpenMP 4.0 semantic: 'a' + 'b' are 'copy' (map fromto) and 28 ! 'c' is firstprivate. 29 !$acc parallel copyout(vals) present(a, b, c) 30 a = [11,12,13,14,15] 31 b = 16 32 c = 47 33 vals(1:5) = a 34 vals(6:6) = b 35 vals(7) = c 36 !$acc end parallel 37 38 if (.not. acc_is_present (a)) stop 13 39 if (.not. acc_is_present (b)) stop 14 40 if (.not. acc_is_present (c)) stop 15 41 42 if (any (vals /= [11,12,13,14,15,16,47])) stop 16 43end subroutine set 44 45subroutine check() 46 use openacc 47 implicit none 48 integer :: g, h(3), i(3) 49 common /another/ g, h, i 50 integer :: val(7) 51 !$acc declare device_resident (/another/) 52 if (.not. acc_is_present (g)) stop 20 53 if (.not. acc_is_present (h)) stop 21 54 if (.not. acc_is_present (i)) stop 22 55 56 val = 99 57 !$acc parallel copyout(val) present(g, h, i) 58 val(5:7) = i 59 val(1) = g 60 val(2:4) = h 61 !$acc end parallel 62 63 if (.not. acc_is_present (g)) stop 23 64 if (.not. acc_is_present (h)) stop 24 65 if (.not. acc_is_present (i)) stop 25 66 67 68 !print *, val 69 if (any (val /= [11,12,13,14,15,16,47])) stop 26 70end subroutine check 71 72 73program test 74 use vars 75 use openacc 76 implicit none 77 real a 78 integer :: k 79 80 call set() 81 call check() 82 83 if (.not. acc_is_present (b)) stop 1 84 if (.not. acc_is_present (x)) stop 2 85 if (.not. acc_is_present (y)) stop 3 86 if (.not. acc_is_present (z)) stop 4 87 88 a = 2.0 89 k = 42 90 91 !$acc parallel copy (a, k) 92 b = a 93 a = 1.0 94 a = a + b 95 x = k 96 y = 7*k - 2*x 97 z = 3*y 98 k = k - z + y 99 !$acc end parallel 100 101 if (.not. acc_is_present (b)) stop 5 102 if (.not. acc_is_present (x)) stop 6 103 if (.not. acc_is_present (y)) stop 7 104 if (.not. acc_is_present (z)) stop 8 105 106 if (a /= 3.0) stop 30 107 if (k /= -378) stop 31 108end program test 109