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.

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 653c43f79ffb1aeac0c0f1f2f7263c200096746d..e0e3b52ad57f9952c1a9586ee884f1f769a5f4ad 100644 (file)
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -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':

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 9bd4e6c7e1b26244a9b6f44b7027b9c9844b4b3c..4bfdf85cd9b056c978c5a2cc35c1cba3e2592cb8 100644 (file)
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -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
                    {

diff --git a/libgomp/testsuite/libgomp.fortran/target-11.f90 b/libgomp/testsuite/libgomp.fortran/target-11.f90
new file mode 100644 (file)
index 0000000..b0faa2e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-11.f90
@@ -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

diff --git a/libgomp/testsuite/libgomp.fortran/target-13.f90 b/libgomp/testsuite/libgomp.fortran/target-13.f90
new file mode 100644 (file)
index 0000000..6aacc77
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-13.f90
@@ -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