openmp: in_reduction support for Fortran

This patch implements support for the in_reduction clause for Fortran.
It also includes more completion of the taskgroup construct inside the
Fortran front-end, thus allowing task_reduction to work for task and
target constructs.

gcc/fortran/ChangeLog:

	* openmp.c (gfc_match_omp_clause_reduction): Add 'openmp_target' default
	false parameter. Add 'always,tofrom' map for OMP_LIST_IN_REDUCTION case.
	(gfc_match_omp_clauses): Add 'openmp_target' default false parameter,
	adjust call to gfc_match_omp_clause_reduction.
	(match_omp): Adjust call to gfc_match_omp_clauses
	* trans-openmp.c (gfc_trans_omp_taskgroup): Add call to
	gfc_match_omp_clause, create and return block.

gcc/ChangeLog:

	* omp-low.c (omp_copy_decl_2): For !ctx, use record_vars to add new copy
	as local variable.
	(scan_sharing_clauses): Place copy of OMP_CLAUSE_IN_REDUCTION decl in
	ctx->outer instead of ctx.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/reduction4.f90: Adjust omp target in_reduction' scan
	pattern.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/target-in-reduction-1.f90: New test.
	* testsuite/libgomp.fortran/target-in-reduction-2.f90: New test.

(cherry picked from commit d98626bf451dea6a28a42d953f7d0bd7659ad4d5)

(This merges the review comments, taken care of in the mainline commit,
referenced above. For OG11, the heavy lifting was already done in
commit 07a380a8a024fbcc61c0098400da9a382b9a7010 )

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 654d121d88ebcc3f80e45cc531d94177a3f30a7b..1f5cc5be599b3c3c2defe21dcc7f61a715cbf944 100644 (file)
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -3581,7 +3581,7 @@ match_omp (gfc_exec_op op, const omp_mask mask)
 {
   gfc_omp_clauses *c;
   if (gfc_match_omp_clauses (&c, mask, true, true, false, false,
-                            (op == EXEC_OMP_TARGET)) != MATCH_YES)
+                            op == EXEC_OMP_TARGET) != MATCH_YES)
     return MATCH_ERROR;
   new_st.op = op;
   new_st.ext.omp_clauses = c;

diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index a2d225ae39eb09b89745332d0045100597aaf35e..43fababb5a3766f7f741918e9590bc2b5bf5ba03 100644 (file)
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -595,7 +595,15 @@ omp_copy_decl_2 (tree var, tree name, tree type, omp_context *ctx)
   tree copy = copy_var_decl (var, name, type);
 
   DECL_CONTEXT (copy) = current_function_decl;
-  DECL_CHAIN (copy) = ctx->block_vars;
+
+  if (ctx)
+    {
+      DECL_CHAIN (copy) = ctx->block_vars;
+      ctx->block_vars = copy;
+    }
+  else
+    record_vars (copy);
+
   /* If VAR is listed in task_shared_vars, it means it wasn't
      originally addressable and is just because task needs to take
      it's address.  But we don't need to take address of privatizations
@@ -606,7 +614,6 @@ omp_copy_decl_2 (tree var, tree name, tree type, omp_context *ctx)
          || (global_nonaddressable_vars
              && bitmap_bit_p (global_nonaddressable_vars, DECL_UID (var)))))
     TREE_ADDRESSABLE (copy) = 0;
-  ctx->block_vars = copy;
 
   return copy;
 }
@@ -1412,13 +1419,9 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
                      gcc_assert (DECL_P (t));
                    }
                  tree at = t;
-                 omp_context *scan_ctx = ctx;
                  if (ctx->outer)
-                   {
-                     scan_omp_op (&at, ctx->outer);
-                     scan_ctx = ctx->outer;
-                   }
-                 tree nt = omp_copy_decl_1 (at, scan_ctx);
+                   scan_omp_op (&at, ctx->outer);
+                 tree nt = omp_copy_decl_1 (at, ctx->outer);
                  splay_tree_insert (ctx->field_map,
                                     (splay_tree_key) &DECL_CONTEXT (t),
                                     (splay_tree_value) nt);
@@ -1457,13 +1460,9 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
          if (is_omp_target (ctx->stmt))
            {
              tree at = decl;
-             omp_context *scan_ctx = ctx;
              if (ctx->outer)
-               {
-                 scan_omp_op (&at, ctx->outer);
-                 scan_ctx = ctx->outer;
-               }
-             tree nt = omp_copy_decl_1 (at, scan_ctx);
+               scan_omp_op (&at, ctx->outer);
+             tree nt = omp_copy_decl_1 (at, ctx->outer);
              splay_tree_insert (ctx->field_map,
                                 (splay_tree_key) &DECL_CONTEXT (decl),
                                 (splay_tree_value) nt);

diff --git a/libgomp/testsuite/libgomp.fortran/target-in-reduction-1.f90 b/libgomp/testsuite/libgomp.fortran/target-in-reduction-1.f90
index 68512e223ac3382b27494fa99136bf35aba8b393..f9acb711e67073bf674ed99ecfbbd425d942f307 100644 (file)
--- a/libgomp/testsuite/libgomp.fortran/target-in-reduction-1.f90
+++ b/libgomp/testsuite/libgomp.fortran/target-in-reduction-1.f90
@@ -1,26 +1,49 @@
 ! { dg-do run }
 
-subroutine foo (x, y)
-  integer :: x, y
+module mod1
+  contains
 
-  !$omp taskgroup task_reduction (+: x, y)
+    subroutine foo (x, y)
+      integer :: x, y
 
-  !$omp target in_reduction (+: x, y)
-  x = x + 8
-  y = y + 16
-  !$omp end target
+      !$omp taskgroup task_reduction (+: x, y)
 
-  !$omp task in_reduction (+: x, y)
-  x = x + 2
-  y = y + 4
-  !$omp end task
+      !$omp target in_reduction (+: x, y)
+      x = x + 8
+      y = y + 16
+      !$omp end target
 
-  !$omp end taskgroup
+      !$omp task in_reduction (+: x, y)
+      x = x + 2
+      y = y + 4
+      !$omp end task
+
+      !$omp end taskgroup
+    end subroutine foo
+
+    integer function bar (x)
+      integer, value :: x
+
+      !$omp taskgroup task_reduction (+: x)
+
+      !$omp target in_reduction (+: x)
+      x = x + 16
+      !$omp end target
+
+      !$omp task in_reduction (+: x)
+      x = x + 32
+      !$omp end task
+
+      !$omp end taskgroup
 
-end subroutine foo
+      bar = x
+    end function bar
+  end module mod1
 
 program main
+  use mod1
   integer :: x, y
+  real :: f;
 
   x = 1
   y = 1
@@ -30,4 +53,26 @@ program main
   if (x .ne. 11) stop 1
   if (y .ne. 21) stop 2
 
+  y = bar (8)
+  if (y .ne. 56) stop 3
+
+  x = 0
+  f = 0.0
+
+  !$omp taskgroup task_reduction (+: x, f)
+  !$omp target in_reduction (+: x, f)
+  x = x + 1
+  f = f + 2.0
+  !$omp end target
+
+  !$omp task in_reduction (+: x, f)
+  x = x + 2
+  f = f + 3.0
+  !$omp end task
+
+  !$omp end taskgroup
+
+  if (x .ne. 3) stop 4
+  if (f .ne. 5.0) stop 5
+
 end program main

diff --git a/libgomp/testsuite/libgomp.fortran/target-in-reduction-2.f90 b/libgomp/testsuite/libgomp.fortran/target-in-reduction-2.f90
new file mode 100644 (file)
index 0000000..7f2e16b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-in-reduction-2.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+
+program main
+  integer :: x
+
+  x = 0
+  !$omp taskgroup task_reduction (+: x)
+  call foo (x)
+  call bar (x)
+  !$omp end taskgroup
+
+  if (x .ne. 3) stop 1
+
+contains
+
+  subroutine foo (x)
+    integer :: x
+    !$omp task in_reduction (+: x)
+    x = x + 1
+    !$omp end task
+  end subroutine foo
+
+  subroutine bar (x)
+    integer :: x
+    !$omp target in_reduction (+: x)
+    x = x + 2
+    !$omp end target
+  end subroutine bar
+
+end program main