OpenMP/Fortran: 'target update' with DT components
OpenMP 5.0 permits to use arrays with derived type components for the list items to the 'from'/'to' clauses of the 'target update' directive. gcc/fortran/ChangeLog: * openmp.cc (gfc_match_omp_clauses): Permit derived types for the 'to' and 'from' clauses of 'target update'. * trans-openmp.cc (gfc_trans_omp_clauses): Fixes for derived-type changes; fix size for scalars. libgomp/ChangeLog: * testsuite/libgomp.fortran/target-11.f90: New test. * testsuite/libgomp.fortran/target-13.f90: New test.
This commit is contained in:
Tobias Burnus
parent
553b1d3dd5
commit
6629444170
4 changed files with 246 additions and 7 deletions
|
|
@ -2499,9 +2499,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
|
|||
true) == MATCH_YES)
|
||||
continue;
|
||||
if ((mask & OMP_CLAUSE_FROM)
|
||||
&& gfc_match_omp_variable_list ("from (",
|
||||
&& (gfc_match_omp_variable_list ("from (",
|
||||
&c->lists[OMP_LIST_FROM], false,
|
||||
NULL, &head, true) == MATCH_YES)
|
||||
NULL, &head, true, true)
|
||||
== MATCH_YES))
|
||||
continue;
|
||||
break;
|
||||
case 'g':
|
||||
|
|
@ -3436,9 +3437,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
|
|||
continue;
|
||||
}
|
||||
else if ((mask & OMP_CLAUSE_TO)
|
||||
&& gfc_match_omp_variable_list ("to (",
|
||||
&& (gfc_match_omp_variable_list ("to (",
|
||||
&c->lists[OMP_LIST_TO], false,
|
||||
NULL, &head, true) == MATCH_YES)
|
||||
NULL, &head, true, true)
|
||||
== MATCH_YES))
|
||||
continue;
|
||||
break;
|
||||
case 'u':
|
||||
|
|
|
|||
|
|
@ -3626,7 +3626,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
|
|||
gcc_unreachable ();
|
||||
}
|
||||
tree node = build_omp_clause (input_location, clause_code);
|
||||
if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
|
||||
if (n->expr == NULL
|
||||
|| (n->expr->ref->type == REF_ARRAY
|
||||
&& n->expr->ref->u.ar.type == AR_FULL
|
||||
&& n->expr->ref->next == NULL))
|
||||
{
|
||||
tree decl = gfc_trans_omp_variable (n->sym, false);
|
||||
if (gfc_omp_privatize_by_reference (decl))
|
||||
|
|
@ -3666,13 +3669,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
|
|||
{
|
||||
tree ptr;
|
||||
gfc_init_se (&se, NULL);
|
||||
if (n->expr->ref->u.ar.type == AR_ELEMENT)
|
||||
if (n->expr->rank == 0)
|
||||
{
|
||||
gfc_conv_expr_reference (&se, n->expr);
|
||||
ptr = se.expr;
|
||||
gfc_add_block_to_block (block, &se.pre);
|
||||
OMP_CLAUSE_SIZE (node)
|
||||
= TYPE_SIZE_UNIT (TREE_TYPE (ptr));
|
||||
= TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (ptr)));
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
|
|||
75
libgomp/testsuite/libgomp.fortran/target-11.f90
Normal file
75
libgomp/testsuite/libgomp.fortran/target-11.f90
Normal file
|
|
@ -0,0 +1,75 @@
|
|||
! Based on libgomp.c/target-23.c
|
||||
|
||||
! { dg-additional-options "-fdump-tree-original" }
|
||||
! { dg-final { scan-tree-dump "omp target update to\\(xxs\\\[3\\\] \\\[len: 2\\\]\\)" "original" } }
|
||||
! { dg-final { scan-tree-dump "omp target update to\\(s\\.s \\\[len: 4\\\]\\)" "original" } }
|
||||
! { dg-final { scan-tree-dump "omp target update from\\(s\\.s \\\[len: 4\\\]\\)" "original" } }
|
||||
|
||||
module m
|
||||
implicit none
|
||||
type S_type
|
||||
integer s
|
||||
integer, pointer :: u(:) => null()
|
||||
integer :: v(0:4)
|
||||
end type S_type
|
||||
integer, volatile :: z
|
||||
end module m
|
||||
|
||||
program main
|
||||
use m
|
||||
implicit none
|
||||
integer, target :: u(0:9) = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
|
||||
logical :: err
|
||||
type (S_type) :: s
|
||||
integer, pointer :: v(:)
|
||||
integer(kind=2) :: xxs(5)
|
||||
err = .false.
|
||||
s = S_type(9, v=[10, 11, 12, 13, 14])
|
||||
s%u(0:) => u(3:)
|
||||
v(-4+3:) => u(3:)
|
||||
xxs = [-1,-2,-3,-4,-5]
|
||||
!$omp target enter data map (to: s%s, s%u, s%u(0:5)) map (alloc: s%v(1:4), xxs(3:5))
|
||||
s%s = s%s + 1
|
||||
u(3) = u(3) + 1
|
||||
s%v(1) = s%v(1) + 1
|
||||
xxs(3) = -33
|
||||
xxs(4) = -44
|
||||
xxs(5) = -55
|
||||
!$omp target update to (xxs(4))
|
||||
!$omp target update to (s%s) to (s%u(0:2), s%v(1:4))
|
||||
|
||||
!$omp target map (alloc: s%s, s%v(1:4)) map (from: err)
|
||||
err = .false.
|
||||
if (s%s /= 10 .or. s%v(1) /= 12 .or. s%v(2) /= 12 .or. s%v(3) /= 13) &
|
||||
err = .true.
|
||||
if (v(-1) /= 4 .or. v(0) /= 4 .or. v(1) /= 5 .or. v(2) /= 6 .or. v(3) /= 7) &
|
||||
err = .true.
|
||||
if (xxs(4) /= -44) &
|
||||
err = .true.
|
||||
s%s = s%s + 1
|
||||
s%v(2) = s%v(2) + 2
|
||||
v(-1) = 5
|
||||
v(3) = 9
|
||||
!$omp end target
|
||||
|
||||
if (err) &
|
||||
error stop
|
||||
|
||||
!$omp target map (alloc: s%u(0:5))
|
||||
err = .false.
|
||||
if (s%u(0) /= 5 .or. s%u(1) /= 4 .or. s%u(2) /= 5 .or. s%u(3) /= 6 .or. s%u(4) /= 9) &
|
||||
err = .true.
|
||||
s%u(1) = 12
|
||||
!$omp end target
|
||||
|
||||
!$omp target update from (s%s, s%u(0:5)) from (s%v(1:4))
|
||||
if (err .or. s%s /= 11 .or. u(0) /= 0 .or. u(1) /= 1 .or. u(2) /= 2 .or. u(3) /= 5 &
|
||||
.or. u(4) /= 12 .or. u(5) /= 5 .or. u(6) /= 6 .or. u(7) /= 9 .or. u(8) /= 8 &
|
||||
.or. u(9) /= 9 .or. s%v(0) /= 10 .or. s%v(1) /= 12 .or. s%v(2) /= 14 &
|
||||
.or. s%v(3) /= 13 .or. s%v(4) /= 14) &
|
||||
error stop
|
||||
! !$omp target exit data map (release: s%s)
|
||||
! !$omp target exit data map (release: s%u(0:5))
|
||||
! !$omp target exit data map (delete: s%v(1:4))
|
||||
! !$omp target exit data map (release: s%s)
|
||||
end
|
||||
159
libgomp/testsuite/libgomp.fortran/target-13.f90
Normal file
159
libgomp/testsuite/libgomp.fortran/target-13.f90
Normal file
|
|
@ -0,0 +1,159 @@
|
|||
module m
|
||||
implicit none
|
||||
type t
|
||||
integer :: s, a(5)
|
||||
end type t
|
||||
|
||||
type t2
|
||||
integer :: s, a(5)
|
||||
type(t) :: st, at(2:3)
|
||||
end type t2
|
||||
|
||||
interface operator(/=)
|
||||
procedure ne_compare_t
|
||||
procedure ne_compare_t2
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
logical pure elemental function ne_compare_t (a, b) result(res)
|
||||
type(t), intent(in) :: a, b
|
||||
res = (a%s /= b%s) .or. any(a%a /= b%a)
|
||||
end function
|
||||
|
||||
logical pure elemental function ne_compare_t2 (a, b) result(res)
|
||||
type(t2), intent(in) :: a, b
|
||||
res = (a%s /= b%s) .or. any(a%a /= b%a) &
|
||||
.or. (a%st /= b%st) .or. any(a%at /= b%at)
|
||||
end function
|
||||
end module m
|
||||
|
||||
program p
|
||||
use m
|
||||
implicit none
|
||||
|
||||
type(t2) :: var1, var2(5), var3(:)
|
||||
type(t2) :: var1a, var2a(5), var3a(:)
|
||||
allocatable :: var3, var3a
|
||||
logical :: shared_memory = .false.
|
||||
|
||||
!$omp target map(to: shared_memory)
|
||||
shared_memory = .true.
|
||||
!$omp end target
|
||||
|
||||
var1 = T2(1, [1,2,3,4,5], T(11, [11,22,33,44,55]), &
|
||||
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])])
|
||||
|
||||
var2 = [T2(101, [201,202,203,204,205], T(2011, [2011,2022,2033,2044,2055]), &
|
||||
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
||||
T2(111, [211,212,213,214,215], T(2111, [2111,2122,2133,2144,2155]), &
|
||||
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
||||
T2(121, [221,222,223,224,225], T(2211, [2211,2222,2233,2244,2255]), &
|
||||
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
||||
T2(131, [231,232,233,234,235], T(2311, [2311,2322,2333,2344,2355]), &
|
||||
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
||||
T2(141, [241,242,243,244,245], T(2411, [2411,2422,2433,2444,2455]), &
|
||||
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])])]
|
||||
|
||||
var3 = [T2(301, [401,402,403,404,405], T(4011, [4011,4022,4033,4044,4055]), &
|
||||
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
||||
T2(311, [411,412,413,414,415], T(4111, [4111,4122,4133,4144,4155]), &
|
||||
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
||||
T2(321, [421,422,423,424,425], T(4211, [4211,4222,4233,4244,4255]), &
|
||||
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
||||
T2(331, [431,432,433,434,435], T(4311, [4311,4322,4333,4344,4355]), &
|
||||
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])]), &
|
||||
T2(341, [441,442,443,444,445], T(4411, [4411,4422,4433,4444,4455]), &
|
||||
[T(-11, [-11,-22,-33,-44,-55]), T(11, [11,22,33,44,55])])]
|
||||
|
||||
var1a = var1
|
||||
var2a = var2
|
||||
var3a = var3
|
||||
|
||||
!$omp target enter data map(to:var1)
|
||||
!$omp target enter data map(to:var2)
|
||||
!$omp target enter data map(to:var3)
|
||||
|
||||
! ---------------
|
||||
|
||||
!$omp target update from(var1%at(2:3))
|
||||
|
||||
if (var1a /= var1) error stop
|
||||
if (any (var2a /= var2)) error stop
|
||||
if (any (var3a /= var3)) error stop
|
||||
|
||||
! ---------------
|
||||
|
||||
!$omp target
|
||||
var1%st%s = 1243
|
||||
var2(3)%at(2) = T(123, [345,64,356,39,13])
|
||||
var2(3)%at(3) = T(48, [74,162,572,357,3])
|
||||
!$omp end target
|
||||
|
||||
if (.not. shared_memory) then
|
||||
if (var1 /= var1) error stop
|
||||
if (any (var2a /= var2)) error stop
|
||||
if (any (var3a /= var3)) error stop
|
||||
endif
|
||||
|
||||
!$omp target update from(var1%st) from(var2(3)%at(2:3))
|
||||
|
||||
var1a%st%s = 1243
|
||||
var2a(3)%at(2) = T(123, [345,64,356,39,13])
|
||||
var2a(3)%at(3) = T(48, [74,162,572,357,3])
|
||||
if (var1 /= var1) error stop
|
||||
if (any (var2a /= var2)) error stop
|
||||
if (any (var3a /= var3)) error stop
|
||||
|
||||
! ---------------
|
||||
|
||||
var3(1) = var2(1)
|
||||
var1%at(2)%a = var2(1)%a
|
||||
var1%at(3)%a = var2(2)%a
|
||||
|
||||
var1a = var1
|
||||
var2a = var2
|
||||
var3a = var3
|
||||
|
||||
!$omp target update to(var3) to(var1%at(2:3))
|
||||
|
||||
!$omp target
|
||||
var3(1)%s = var3(1)%s + 123
|
||||
var1%at(2)%a = var1%at(2)%a * 7
|
||||
var1%at(3)%s = var1%at(3)%s * (-3)
|
||||
!$omp end target
|
||||
|
||||
if (.not. shared_memory) then
|
||||
if (var1 /= var1) error stop
|
||||
if (any (var2a /= var2)) error stop
|
||||
if (any (var3a /= var3)) error stop
|
||||
endif
|
||||
|
||||
var3a(1)%s = var3a(1)%s + 123
|
||||
var1a%at(2)%a = var1a%at(2)%a * 7
|
||||
var1a%at(3)%s = var1a%at(3)%s * (-3)
|
||||
|
||||
block
|
||||
integer, volatile :: i1,i2,i3,i4
|
||||
i1 = 1
|
||||
i2 = 2
|
||||
i3 = 1
|
||||
i4 = 2
|
||||
!$omp target update from(var3(i1:i2)) from(var1%at(i3:i4))
|
||||
i1 = 3
|
||||
i2 = 3
|
||||
i3 = 1
|
||||
i4 = 5
|
||||
!$omp target update from(var1%at(i1)%s) from(var1%at(i2)%a(i3:i4))
|
||||
end block
|
||||
|
||||
if (var1 /= var1) error stop
|
||||
if (any (var2a /= var2)) error stop
|
||||
if (any (var3a /= var3)) error stop
|
||||
|
||||
! ---------------
|
||||
|
||||
!$omp target exit data map(from:var1)
|
||||
!$omp target exit data map(from:var2)
|
||||
!$omp target exit data map(from:var3)
|
||||
end
|
||||
Loading…
Add table
Reference in a new issue