293 lines
9.4 KiB
Fortran
293 lines
9.4 KiB
Fortran
|
! { 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" } }
|