| ! { dg-do run } |
| ! { dg-additional-options "-fdump-tree-gimple" } |
| ! |
| ! PR fortran/92568 |
| ! |
| program main |
| implicit none |
| integer :: xa1, xa2, xp1, xp2, xat1, xat2, xt1, xt2, xi1, xi2 |
| allocatable :: xa1, xa2, xat1, xat2 |
| pointer :: xp1, xp2 |
| |
| allocate (xa1, xa2, xat1, xat2, xp1, xp2) |
| |
| call foo (xa1, xa2, xp1, xp2, xat1, xat2, xt1, xt2, xi1, xi2) |
| call foo2 (xa1, xa2, xp1, xp2, xat1, xat2, xt1, xt2, xi1, xi2) |
| call foo3 (xa1, xa2, xp1, xp2, xat1, xat2, xt1, xt2, xi1, xi2) |
| call bar (xa1, xa2, xp1, xp2, xat1, xat2, xt1, xt2, xi1, xi2) |
| |
| deallocate (xa1, xa2, xat1, xat2, xp1, xp2) |
| contains |
| ! Implicit mapping |
| subroutine foo (ia1, ia2, ip1, ip2, iat1, iat2, it1, it2, ii1, ii2) |
| implicit none |
| integer :: ia1, ia2, ia3, ip1, ip2, ip3, iat1, iat2, iat3, it1, it2, it3, ii1, ii2, ii3 |
| allocatable :: ia1, ia2, ia3, iat1, iat2, iat3 |
| pointer :: ip1, ip2, ip3 |
| target :: iat1, iat2, iat3, it1, it2, it3 |
| optional :: ia1, ip1, iat1, it1, ii1 |
| |
| allocate(ia3, iat3, ip3) |
| |
| ia1 = 2; ia2 = 2; ia3 = 2; ip1 = 2; ip2 = 2; ip3 = 2; |
| iat1 = 2; iat2 = 2; iat3 = 2; it1 = 2; it2 = 2; it3 = 2 |
| ii1 = 2; ii2 = 2; ii3 = 2 |
| |
| ! Implicitly, scalars are 'firstprivate' except |
| ! if target, allocatable, pointer they are always tofrom. |
| !$omp target |
| if (ia1 /= 2) stop 1 |
| if (ia2 /= 2) stop 2 |
| if (ia3 /= 2) stop 3 |
| if (ip1 /= 2) stop 4 |
| if (ip2 /= 2) stop 5 |
| if (ip3 /= 2) stop 6 |
| if (iat1 /= 2) stop 7 |
| if (iat2 /= 2) stop 8 |
| if (iat3 /= 2) stop 9 |
| if (it1 /= 2) stop 10 |
| if (it2 /= 2) stop 11 |
| if (it3 /= 2) stop 12 |
| if (ii1 /= 2) stop 13 |
| if (ii2 /= 2) stop 14 |
| if (ii3 /= 2) stop 15 |
| |
| ia1 = 1; ia2 = 1; ia3 = 1; ip1 = 1; ip2 = 1; ip3 = 1; |
| iat1 = 1; iat2 = 1; iat3 = 1; it1 = 1; it2 = 1; it3 = 1 |
| ii1 = 1; ii2 = 1; ii3 = 1 |
| !$omp end target |
| |
| ! (target,allocatable,pointer) -> tofrom |
| if (ia1 /= 1) stop 16 |
| if (ia2 /= 1) stop 17 |
| if (ia3 /= 1) stop 18 |
| if (ip1 /= 1) stop 19 |
| if (ip2 /= 1) stop 20 |
| if (ip3 /= 1) stop 21 |
| if (iat1 /= 1) stop 22 |
| if (iat2 /= 1) stop 23 |
| if (iat3 /= 1) stop 24 |
| if (it1 /= 1) stop 25 |
| if (it2 /= 1) stop 26 |
| if (it3 /= 1) stop 27 |
| ! non-(target,allocatable,pointer) -> firstprivate |
| !if (ii1 /= 2) stop 28 ! FIXME: optional scalar wrongly mapped as tofrom, PR fortran/100991 |
| if (ii2 /= 2) stop 29 |
| if (ii3 /= 2) stop 30 |
| |
| deallocate(ia3, iat3, ip3) |
| end |
| |
| ! Implicit mapping likewise even though there is defaultmap |
| subroutine foo2 (ia1, ia2, ip1, ip2, iat1, iat2, it1, it2, ii1, ii2) |
| implicit none |
| integer :: ia1, ia2, ia3, ip1, ip2, ip3, iat1, iat2, iat3, it1, it2, it3, ii1, ii2, ii3 |
| allocatable :: ia1, ia2, ia3, iat1, iat2, iat3 |
| pointer :: ip1, ip2, ip3 |
| target :: iat1, iat2, iat3, it1, it2, it3 |
| optional :: ia1, ip1, iat1, it1, ii1 |
| |
| allocate(ia3, iat3, ip3) |
| |
| ia1 = 2; ia2 = 2; ia3 = 2; ip1 = 2; ip2 = 2; ip3 = 2; |
| iat1 = 2; iat2 = 2; iat3 = 2; it1 = 2; it2 = 2; it3 = 2 |
| ii1 = 2; ii2 = 2; ii3 = 2 |
| |
| ! Implicitly, scalars are 'firstprivate' except |
| ! if target, allocatable, pointer they are always tofrom. |
| !$omp target defaultmap(default) |
| if (ia1 /= 2) stop 31 |
| if (ia2 /= 2) stop 32 |
| if (ia3 /= 2) stop 33 |
| if (ip1 /= 2) stop 34 |
| if (ip2 /= 2) stop 35 |
| if (ip3 /= 2) stop 36 |
| if (iat1 /= 2) stop 37 |
| if (iat2 /= 2) stop 38 |
| if (iat3 /= 2) stop 39 |
| if (it1 /= 2) stop 40 |
| if (it2 /= 2) stop 41 |
| if (it3 /= 2) stop 42 |
| if (ii1 /= 2) stop 43 |
| if (ii2 /= 2) stop 44 |
| if (ii3 /= 2) stop 45 |
| |
| ia1 = 1; ia2 = 1; ia3 = 1; ip1 = 1; ip2 = 1; ip3 = 1; |
| iat1 = 1; iat2 = 1; iat3 = 1; it1 = 1; it2 = 1; it3 = 1 |
| ii1 = 1; ii2 = 1; ii3 = 1 |
| !$omp end target |
| |
| ! (target,allocatable,pointer) -> tofrom |
| if (ia1 /= 1) stop 46 |
| if (ia2 /= 1) stop 47 |
| if (ia3 /= 1) stop 48 |
| if (ip1 /= 1) stop 49 |
| if (ip2 /= 1) stop 50 |
| if (ip3 /= 1) stop 51 |
| if (iat1 /= 1) stop 52 |
| if (iat2 /= 1) stop 53 |
| if (iat3 /= 1) stop 54 |
| if (it1 /= 1) stop 55 |
| if (it2 /= 1) stop 56 |
| if (it3 /= 1) stop 57 |
| ! non-(target,allocatable,pointer) -> firstprivate |
| !if (ii1 /= 2) stop 58 ! FIXME: optional scalar wrongly mapped as tofrom, PR fortran/100991 |
| if (ii2 /= 2) stop 59 |
| if (ii3 /= 2) stop 60 |
| |
| deallocate(ia3, iat3, ip3) |
| end |
| |
| ! Implicit mapping likewise even though there is defaultmap |
| subroutine foo3 (ia1, ia2, ip1, ip2, iat1, iat2, it1, it2, ii1, ii2) |
| implicit none |
| integer :: ia1, ia2, ia3, ip1, ip2, ip3, iat1, iat2, iat3, it1, it2, it3, ii1, ii2, ii3 |
| allocatable :: ia1, ia2, ia3, iat1, iat2, iat3 |
| pointer :: ip1, ip2, ip3 |
| target :: iat1, iat2, iat3, it1, it2, it3 |
| optional :: ia1, ip1, iat1, it1, ii1 |
| |
| allocate(ia3, iat3, ip3) |
| |
| ia1 = 2; ia2 = 2; ia3 = 2; ip1 = 2; ip2 = 2; ip3 = 2; |
| iat1 = 2; iat2 = 2; iat3 = 2; it1 = 2; it2 = 2; it3 = 2 |
| ii1 = 2; ii2 = 2; ii3 = 2 |
| |
| ! Implicitly, scalars are 'firstprivate' except |
| ! if target, allocatable, pointer they are always tofrom. |
| !$omp target defaultmap(none:aggregate) |
| if (ia1 /= 2) stop 61 |
| if (ia2 /= 2) stop 62 |
| if (ia3 /= 2) stop 63 |
| if (ip1 /= 2) stop 64 |
| if (ip2 /= 2) stop 65 |
| if (ip3 /= 2) stop 66 |
| if (iat1 /= 2) stop 67 |
| if (iat2 /= 2) stop 68 |
| if (iat3 /= 2) stop 69 |
| if (it1 /= 2) stop 70 |
| if (it2 /= 2) stop 71 |
| if (it3 /= 2) stop 72 |
| if (ii1 /= 2) stop 73 |
| if (ii2 /= 2) stop 74 |
| if (ii3 /= 2) stop 75 |
| |
| ia1 = 1; ia2 = 1; ia3 = 1; ip1 = 1; ip2 = 1; ip3 = 1; |
| iat1 = 1; iat2 = 1; iat3 = 1; it1 = 1; it2 = 1; it3 = 1 |
| ii1 = 1; ii2 = 1; ii3 = 1 |
| !$omp end target |
| |
| ! (target,allocatable,pointer) -> tofrom |
| if (ia1 /= 1) stop 76 |
| if (ia2 /= 1) stop 77 |
| if (ia3 /= 1) stop 78 |
| if (ip1 /= 1) stop 79 |
| if (ip2 /= 1) stop 80 |
| if (ip3 /= 1) stop 81 |
| if (iat1 /= 1) stop 82 |
| if (iat2 /= 1) stop 83 |
| if (iat3 /= 1) stop 84 |
| if (it1 /= 1) stop 85 |
| if (it2 /= 1) stop 86 |
| if (it3 /= 1) stop 87 |
| ! non-(target,allocatable,pointer) -> firstprivate |
| !if (ii1 /= 2) stop 88 ! FIXME: optional scalar wrongly mapped as tofrom, PR fortran/100991 |
| if (ii2 /= 2) stop 89 |
| if (ii3 /= 2) stop 90 |
| |
| deallocate(ia3, iat3, ip3) |
| end |
| |
| subroutine bar (ea1, ea2, ep1, ep2, eat1, eat2, et1, et2, ei1, ei2) |
| implicit none |
| integer :: ea1, ea2, ea3, ep1, ep2, ep3, eat1, eat2, eat3, et1, et2, et3, ei1, ei2, ei3 |
| allocatable :: ea1, ea2, ea3, eat1, eat2, eat3 |
| pointer :: ep1, ep2, ep3 |
| target :: eat1, eat2, eat3, et1, et2, et3 |
| optional :: ea1, ep1, eat1, et1, ei1 |
| logical :: shared_memory |
| |
| allocate(ea3, eat3, ep3) |
| |
| ea1 = 2; ea2 = 2; ea3 = 2; ep1 = 2; ep2 = 2; ep3 = 2; |
| eat1 = 2; eat2 = 2; eat3 = 2; et1 = 2; et2 = 2; et3 = 2 |
| ei1 = 2; ei2 = 2; ei3 = 2 |
| |
| shared_memory = .false. |
| !$omp target map(to: shared_memory) |
| shared_memory = .true. |
| !$omp end target |
| |
| ! While here 'scalar' implies nonallocatable/nonpointer and |
| ! the target attribute plays no role. |
| !$omp target defaultmap(tofrom:scalar) defaultmap(firstprivate:allocatable) & |
| !$omp& defaultmap(none:aggregate) defaultmap(firstprivate:pointer) & |
| !$omp& map(always, to: shared_memory) |
| if (shared_memory) then |
| ! Due to fortran/90742 this fails when doing non-shared memory offloading |
| if (ea1 /= 2) stop 91 |
| if (ea2 /= 2) stop 92 |
| if (ea3 /= 2) stop 93 |
| if (ep1 /= 2) stop 94 |
| if (ep2 /= 2) stop 95 |
| if (ep3 /= 2) stop 96 |
| if (eat1 /= 2) stop 97 |
| if (eat2 /= 2) stop 98 |
| if (eat3 /= 2) stop 99 |
| end if |
| if (et1 /= 2) stop 100 |
| if (et2 /= 2) stop 101 |
| if (et3 /= 2) stop 102 |
| if (ei1 /= 2) stop 103 |
| if (ei2 /= 2) stop 104 |
| if (ei3 /= 2) stop 105 |
| ep1 => null(); ep2 => null(); ep3 => null() |
| if (shared_memory) then |
| ! Due to fortran/90742 this fails when doing non-shared memory offloading |
| ea1 = 1; ea2 = 1; ea3 = 1 |
| eat1 = 1; eat2 = 1; eat3 = 1 |
| end if |
| et1 = 1; et2 = 1; et3 = 1 |
| ei1 = 1; ei2 = 1; ei3 = 1 |
| !$omp end target |
| ! (allocatable,pointer) -> firstprivate |
| |
| ! FIXME: allocatables not properly privatized, cf. PR fortran/90742 |
| |
| ! if (ea1 /= 2) stop 106 |
| ! if (ea2 /= 2) stop 107 |
| ! if (ea3 /= 2) stop 108 |
| ! if (eat1 /= 2) stop 112 |
| ! if (eat2 /= 2) stop 113 |
| ! if (eat3 /= 2) stop 114 |
| if (ep1 /= 2) stop 109 |
| if (ep2 /= 2) stop 110 |
| if (ep3 /= 2) stop 111 |
| ! (scalar) -> tofrom |
| !if (et1 /= 1) stop 115 ! FIXME: optional scalar wrongly mapped as 'firstprivate', PR fortran/100991 |
| if (et2 /= 1) stop 116 |
| if (et3 /= 1) stop 117 |
| !if (ei1 /= 1) stop 118 ! FIXME: optional scalar wrongly mapped as 'firstprivate', PR fortran/100991 |
| if (ei2 /= 1) stop 119 |
| if (ei3 /= 1) stop 120 |
| |
| deallocate(ea3, eat3, ep3) |
| end |
| |
| end |
| |
| ! FIXME/xfail: Optional scalars wrongly classified, PR fortran/100991 |
| ! { dg-final { scan-tree-dump-times "firstprivate\\(ii1\\)" 3 "gimple" { xfail *-*-* } } } |
| ! { dg-final { scan-tree-dump-not "firstprivate\\(et1\\)" "gimple" { xfail *-*-* } } } |
| ! { dg-final { scan-tree-dump-not "firstprivate\\(ei1\\)" "gimple" { xfail *-*-* } } } |
| |
| ! { dg-final { scan-tree-dump-times "firstprivate\\(ea1\\)" 1 "gimple" } } |
| ! { dg-final { scan-tree-dump-times "firstprivate\\(ea2\\)" 1 "gimple" } } |
| ! { dg-final { scan-tree-dump-times "firstprivate\\(ea3\\)" 1 "gimple" } } |
| ! { dg-final { scan-tree-dump-times "firstprivate\\(eat1\\)" 1 "gimple" } } |
| ! { dg-final { scan-tree-dump-times "firstprivate\\(eat2\\)" 1 "gimple" } } |
| ! { dg-final { scan-tree-dump-times "firstprivate\\(eat3\\)" 1 "gimple" } } |
| ! { dg-final { scan-tree-dump-times "firstprivate\\(ep1\\)" 1 "gimple" } } |
| ! { dg-final { scan-tree-dump-times "firstprivate\\(ep2\\)" 1 "gimple" } } |
| ! { dg-final { scan-tree-dump-times "firstprivate\\(ep3\\)" 1 "gimple" } } |
