102502e32e
gcc/fortran/ChangeLog: * openmp.c (gfc_match_omp_clauses): Match also derived-type component refs in OMP_CLAUSE_MAP. (resolve_omp_clauses): Resolve those. * trans-openmp.c (gfc_trans_omp_array_section, gfc_trans_omp_clauses): Handle OpenMP structure-element mapping. (gfc_trans_oacc_construct, gfc_trans_oacc_executable_directive, (gfc_trans_oacc_combined_directive, gfc_trans_oacc_declare): Update add openacc=true in gfc_trans_omp_clauses call. gcc/testsuite/ChangeLog: * gfortran.dg/goacc/finalize-1.f: Update dump scan pattern. * gfortran.dg/gomp/map-1.f90: Update dg-error. * gfortran.dg/gomp/map-2.f90: New test. libgomp/ChangeLog: * testsuite/libgomp.fortran/struct-elem-map-1.f90: New test.
332 lines
11 KiB
Fortran
332 lines
11 KiB
Fortran
! { dg-do run }
|
||
!
|
||
! Test OpenMP 4.5 structure-element mapping
|
||
|
||
! TODO: character(kind=4,...) needs to be tested, but depends on
|
||
! PR fortran/95837
|
||
! TODO: ...%str4 should be tested but that currently fails due to
|
||
! PR fortran/95868 (see commented lined)
|
||
! TODO: Test also array-valued var, nested derived types,
|
||
! type-extended types.
|
||
|
||
program main
|
||
implicit none
|
||
|
||
type t2
|
||
integer :: a, b
|
||
! For complex, assume small integers are exactly representable
|
||
complex(kind=8) :: c
|
||
integer :: d(10)
|
||
integer, pointer :: e => null(), f(:) => null()
|
||
character(len=5) :: str1
|
||
character(len=5) :: str2(4)
|
||
character(len=:), pointer :: str3 => null()
|
||
character(len=:), pointer :: str4(:) => null()
|
||
end type t2
|
||
|
||
integer :: i
|
||
|
||
call one ()
|
||
call two ()
|
||
call three ()
|
||
call four ()
|
||
call five ()
|
||
call six ()
|
||
call seven ()
|
||
call eight ()
|
||
|
||
contains
|
||
! Implicitly mapped – but no pointers are mapped
|
||
subroutine one()
|
||
type(t2) :: var, var2(4)
|
||
type(t2), pointer :: var3, var4(:)
|
||
|
||
print '(g0)', '==== TESTCASE "one" ===='
|
||
|
||
var = t2(a = 1, &
|
||
b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
|
||
d = [(-3*i, i = 1, 10)], &
|
||
str1 = "abcde", &
|
||
str2 = ["12345", "67890", "ABCDE", "FGHIJ"])
|
||
allocate (var%e, source=99)
|
||
allocate (var%f, source=[22, 33, 44, 55])
|
||
allocate (var%str3, source="HelloWorld")
|
||
allocate (var%str4, source=["Let's", "Go!!!"])
|
||
|
||
!$omp target map(tofrom:var)
|
||
if (var%a /= 1) stop 1
|
||
if (var%b /= 2) stop 2
|
||
if (var%c%re /= -1.0_8 .or. var%c%im /= 2.0_8) stop 3
|
||
if (any (var%d /= [(-3*i, i = 1, 10)])) stop 4
|
||
if (var%str1 /= "abcde") stop 5
|
||
if (any (var%str2 /= ["12345", "67890", "ABCDE", "FGHIJ"])) stop 6
|
||
!$omp end target
|
||
|
||
deallocate(var%e, var%f, var%str3, var%str4)
|
||
end subroutine one
|
||
|
||
! Explicitly mapped – all and full arrays
|
||
subroutine two()
|
||
type(t2) :: var, var2(4)
|
||
type(t2), pointer :: var3, var4(:)
|
||
|
||
print '(g0)', '==== TESTCASE "two" ===='
|
||
|
||
var = t2(a = 1, &
|
||
b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
|
||
d = [(-3*i, i = 1, 10)], &
|
||
str1 = "abcde", &
|
||
str2 = ["12345", "67890", "ABCDE", "FGHIJ"])
|
||
allocate (var%e, source=99)
|
||
allocate (var%f, source=[22, 33, 44, 55])
|
||
allocate (var%str3, source="HelloWorld")
|
||
allocate (var%str4, source=["Let's", "Go!!!"])
|
||
|
||
!$omp target map(tofrom: var%a, var%b, var%c, var%d, var%e, var%f, &
|
||
!$omp& var%str1, var%str2, var%str3, var%str4)
|
||
if (var%a /= 1) stop 1
|
||
if (var%b /= 2) stop 2
|
||
if (var%c%re /= -1.0_8 .or. var%c%im /= 2.0_8) stop 3
|
||
if (any (var%d /= [(-3*i, i = 1, 10)])) stop 4
|
||
if (var%str1 /= "abcde") stop 5
|
||
if (any (var%str2 /= ["12345", "67890", "ABCDE", "FGHIJ"])) stop 6
|
||
|
||
if (.not. associated (var%e)) stop 7
|
||
if (var%e /= 99) stop 8
|
||
if (.not. associated (var%f)) stop 9
|
||
if (size (var%f) /= 4) stop 10
|
||
if (any (var%f /= [22, 33, 44, 55])) stop 11
|
||
if (.not. associated (var%str3)) stop 12
|
||
if (len (var%str3) /= len ("HelloWorld")) stop 13
|
||
if (var%str3 /= "HelloWorld") stop 14
|
||
if (.not. associated (var%str4)) stop 15
|
||
if (len (var%str4) /= 5) stop 16
|
||
if (size (var%str4) /= 2) stop 17
|
||
if (any (var%str4 /= ["Let's", "Go!!!"])) stop 18
|
||
!$omp end target
|
||
|
||
deallocate(var%e, var%f, var%str3, var%str4)
|
||
end subroutine two
|
||
|
||
! Explicitly mapped – one by one but full arrays
|
||
subroutine three()
|
||
type(t2) :: var, var2(4)
|
||
type(t2), pointer :: var3, var4(:)
|
||
|
||
print '(g0)', '==== TESTCASE "three" ===='
|
||
|
||
var = t2(a = 1, &
|
||
b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
|
||
d = [(-3*i, i = 1, 10)], &
|
||
str1 = "abcde", &
|
||
str2 = ["12345", "67890", "ABCDE", "FGHIJ"])
|
||
allocate (var%e, source=99)
|
||
allocate (var%f, source=[22, 33, 44, 55])
|
||
allocate (var%str3, source="HelloWorld")
|
||
allocate (var%str4, source=["Let's", "Go!!!"])
|
||
|
||
!$omp target map(tofrom: var%a)
|
||
if (var%a /= 1) stop 1
|
||
!$omp end target
|
||
!$omp target map(tofrom: var%b)
|
||
if (var%b /= 2) stop 2
|
||
!$omp end target
|
||
!$omp target map(tofrom: var%c)
|
||
if (var%c%re /= -1.0_8 .or. var%c%im /= 2.0_8) stop 3
|
||
!$omp end target
|
||
!$omp target map(tofrom: var%d)
|
||
if (any (var%d /= [(-3*i, i = 1, 10)])) stop 4
|
||
!$omp end target
|
||
!$omp target map(tofrom: var%str1)
|
||
if (var%str1 /= "abcde") stop 5
|
||
!$omp end target
|
||
!$omp target map(tofrom: var%str2)
|
||
if (any (var%str2 /= ["12345", "67890", "ABCDE", "FGHIJ"])) stop 6
|
||
!$omp end target
|
||
|
||
!$omp target map(tofrom: var%e)
|
||
if (.not. associated (var%e)) stop 7
|
||
if (var%e /= 99) stop 8
|
||
!$omp end target
|
||
!$omp target map(tofrom: var%f)
|
||
if (.not. associated (var%f)) stop 9
|
||
if (size (var%f) /= 4) stop 10
|
||
if (any (var%f /= [22, 33, 44, 55])) stop 11
|
||
!$omp end target
|
||
!$omp target map(tofrom: var%str3)
|
||
if (.not. associated (var%str3)) stop 12
|
||
if (len (var%str3) /= len ("HelloWorld")) stop 13
|
||
if (var%str3 /= "HelloWorld") stop 14
|
||
!$omp end target
|
||
!$omp target map(tofrom: var%str4)
|
||
if (.not. associated (var%str4)) stop 15
|
||
if (len (var%str4) /= 5) stop 16
|
||
if (size (var%str4) /= 2) stop 17
|
||
if (any (var%str4 /= ["Let's", "Go!!!"])) stop 18
|
||
!$omp end target
|
||
|
||
deallocate(var%e, var%f, var%str3, var%str4)
|
||
end subroutine three
|
||
|
||
! Explicitly mapped – all but only subarrays
|
||
subroutine four()
|
||
type(t2) :: var, var2(4)
|
||
type(t2), pointer :: var3, var4(:)
|
||
|
||
print '(g0)', '==== TESTCASE "four" ===='
|
||
|
||
var = t2(a = 1, &
|
||
b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
|
||
d = [(-3*i, i = 1, 10)], &
|
||
str1 = "abcde", &
|
||
str2 = ["12345", "67890", "ABCDE", "FGHIJ"])
|
||
allocate (var%f, source=[22, 33, 44, 55])
|
||
allocate (var%str4, source=["Let's", "Go!!!"])
|
||
|
||
! !$omp target map(tofrom: var%d(4:7), var%f(2:3), var%str2(2:3), var%str4(2:2))
|
||
!$omp target map(tofrom: var%d(4:7), var%f(2:3), var%str2(2:3))
|
||
if (any (var%d(4:7) /= [(-3*i, i = 4, 7)])) stop 4
|
||
if (any (var%str2(2:3) /= ["67890", "ABCDE"])) stop 6
|
||
|
||
if (.not. associated (var%f)) stop 9
|
||
if (size (var%f) /= 4) stop 10
|
||
if (any (var%f(2:3) /= [33, 44])) stop 11
|
||
! if (.not. associated (var%str4)) stop 15
|
||
! if (len (var%str4) /= 5) stop 16
|
||
! if (size (var%str4) /= 2) stop 17
|
||
! if (var%str4(2) /= "Go!!!") stop 18
|
||
!$omp end target
|
||
|
||
deallocate(var%f, var%str4)
|
||
end subroutine four
|
||
|
||
! Explicitly mapped – all but only subarrays and one by one
|
||
subroutine five()
|
||
type(t2) :: var, var2(4)
|
||
type(t2), pointer :: var3, var4(:)
|
||
|
||
print '(g0)', '==== TESTCASE "five" ===='
|
||
|
||
var = t2(a = 1, &
|
||
b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
|
||
d = [(-3*i, i = 1, 10)], &
|
||
str1 = "abcde", &
|
||
str2 = ["12345", "67890", "ABCDE", "FGHIJ"])
|
||
allocate (var%f, source=[22, 33, 44, 55])
|
||
allocate (var%str4, source=["Let's", "Go!!!"])
|
||
|
||
!$omp target map(tofrom: var%d(4:7))
|
||
if (any (var%d(4:7) /= [(-3*i, i = 4, 7)])) stop 4
|
||
!$omp end target
|
||
!$omp target map(tofrom: var%str2(2:3))
|
||
if (any (var%str2(2:3) /= ["67890", "ABCDE"])) stop 6
|
||
!$omp end target
|
||
|
||
!$omp target map(tofrom: var%f(2:3))
|
||
if (.not. associated (var%f)) stop 9
|
||
if (size (var%f) /= 4) stop 10
|
||
if (any (var%f(2:3) /= [33, 44])) stop 11
|
||
!$omp end target
|
||
! !$omp target map(tofrom: var%str4(2:2))
|
||
! if (.not. associated (var%str4)) stop 15
|
||
! if (len (var%str4) /= 5) stop 16
|
||
! if (size (var%str4) /= 2) stop 17
|
||
! if (var%str4(2) /= "Go!!!") stop 18
|
||
! !$omp end target
|
||
|
||
deallocate(var%f, var%str4)
|
||
end subroutine five
|
||
|
||
! Explicitly mapped – all but only array elements
|
||
subroutine six()
|
||
type(t2) :: var, var2(4)
|
||
type(t2), pointer :: var3, var4(:)
|
||
|
||
print '(g0)', '==== TESTCASE "six" ===='
|
||
|
||
var = t2(a = 1, &
|
||
b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
|
||
d = [(-3*i, i = 1, 10)], &
|
||
str1 = "abcde", &
|
||
str2 = ["12345", "67890", "ABCDE", "FGHIJ"])
|
||
allocate (var%f, source=[22, 33, 44, 55])
|
||
allocate (var%str4, source=["Let's", "Go!!!"])
|
||
|
||
! !$omp target map(tofrom: var%d(5), var%f(3), var%str2(3), var%str4(2))
|
||
!$omp target map(tofrom: var%d(5), var%f(3), var%str2(3))
|
||
if (var%d(5) /= -3*5) stop 4
|
||
if (var%str2(3) /= "ABCDE") stop 6
|
||
|
||
if (.not. associated (var%f)) stop 9
|
||
if (size (var%f) /= 4) stop 10
|
||
if (var%f(3) /= 44) stop 11
|
||
! if (.not. associated (var%str4)) stop 15
|
||
! if (len (var%str4) /= 5) stop 16
|
||
! if (size (var%str4) /= 2) stop 17
|
||
! if (var%str4(2) /= "Go!!!") stop 18
|
||
!$omp end target
|
||
|
||
deallocate(var%f, var%str4)
|
||
end subroutine six
|
||
|
||
! Explicitly mapped – all but only array elements and one by one
|
||
subroutine seven()
|
||
type(t2) :: var, var2(4)
|
||
type(t2), pointer :: var3, var4(:)
|
||
|
||
print '(g0)', '==== TESTCASE "seven" ===='
|
||
|
||
var = t2(a = 1, &
|
||
b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
|
||
d = [(-3*i, i = 1, 10)], &
|
||
str1 = "abcde", &
|
||
str2 = ["12345", "67890", "ABCDE", "FGHIJ"])
|
||
allocate (var%f, source=[22, 33, 44, 55])
|
||
allocate (var%str4, source=["Let's", "Go!!!"])
|
||
|
||
!$omp target map(tofrom: var%d(5))
|
||
if (var%d(5) /= (-3*5)) stop 4
|
||
!$omp end target
|
||
!$omp target map(tofrom: var%str2(2:3))
|
||
if (any (var%str2(2:3) /= ["67890", "ABCDE"])) stop 6
|
||
!$omp end target
|
||
|
||
!$omp target map(tofrom: var%f(2:3))
|
||
if (.not. associated (var%f)) stop 9
|
||
if (size (var%f) /= 4) stop 10
|
||
if (any (var%f(2:3) /= [33, 44])) stop 11
|
||
!$omp end target
|
||
! !$omp target map(tofrom: var%str4(2:2))
|
||
! if (.not. associated (var%str4)) stop 15
|
||
! if (len (var%str4) /= 5) stop 16
|
||
! if (size (var%str4) /= 2) stop 17
|
||
! if (var%str4(2) /= "Go!!!") stop 18
|
||
! !$omp end target
|
||
|
||
deallocate(var%f, var%str4)
|
||
end subroutine seven
|
||
|
||
! Check mapping of NULL pointers
|
||
subroutine eight()
|
||
type(t2) :: var, var2(4)
|
||
type(t2), pointer :: var3, var4(:)
|
||
|
||
print '(g0)', '==== TESTCASE "eight" ===='
|
||
|
||
var = t2(a = 1, &
|
||
b = 2, c = cmplx(-1.0_8, 2.0_8,kind=8), &
|
||
d = [(-3*i, i = 1, 10)], &
|
||
str1 = "abcde", &
|
||
str2 = ["12345", "67890", "ABCDE", "FGHIJ"])
|
||
|
||
! !$omp target map(tofrom: var%e, var%f, var%str3, var%str4)
|
||
!$omp target map(tofrom: var%e, var%str3)
|
||
if (associated (var%e)) stop 1
|
||
! if (associated (var%f)) stop 2
|
||
if (associated (var%str3)) stop 3
|
||
! if (associated (var%str4)) stop 4
|
||
!$omp end target
|
||
end subroutine eight
|
||
|
||
end program main
|