[gcc r13-4702] OpenMP/Fortran: Combined directives with map/firstprivate of same symbol

[gcc r13-4702] OpenMP/Fortran: Combined directives with map/firstprivate of same symbol

[Julian Brown]

https://gcc.gnu.org/g:9316ad3b4354cbf2980f86902e54884e918c472a

commit r13-4702-g9316ad3b4354cbf2980f86902e54884e918c472a
Author: Julian Brown <julian@codesourcery.com>
Date:   Tue Dec 6 12:18:33 2022 +0000

    OpenMP/Fortran: Combined directives with map/firstprivate of same symbol
    
    This patch fixes a case where a combined directive (e.g. "!$omp target
    parallel ...") contains both a map and a firstprivate clause for the
    same variable.  When the combined directive is split into two nested
    directives, the outer "target" gets the "map" clause, and the inner
    "parallel" gets the "firstprivate" clause, like so:
    
      !$omp target parallel map(x) firstprivate(x)
    
      -->
    
      !$omp target map(x)
        !$omp parallel firstprivate(x)
          ...
    
    When there is no map of the same variable, the firstprivate is distributed
    to both directives, e.g. for 'y' in:
    
      !$omp target parallel map(x) firstprivate(y)
    
      -->
    
      !$omp target map(x) firstprivate(y)
        !$omp parallel firstprivate(y)
          ...
    
    This is not a recent regression, but appear to fix a long-standing ICE.
    (The included testcase is based on one by Tobias.)
    
    2022-12-06  Julian Brown  <julian@codesourcery.com>
    
    gcc/fortran/
            * trans-openmp.cc (gfc_add_firstprivate_if_unmapped): New function.
            (gfc_split_omp_clauses): Call above.
    
    libgomp/
            * testsuite/libgomp.fortran/combined-directive-splitting-1.f90: New
            test.

Diff:
---
 gcc/fortran/trans-openmp.cc                        | 37 +++++++++++++++++--
 .../combined-directive-splitting-1.f90             | 41 ++++++++++++++++++++++
 2 files changed, 76 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 7a4a3390b6d..395bcc98e00 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -5968,6 +5968,39 @@ gfc_add_clause_implicitly (gfc_omp_clauses *clauses_out,
     }
 }
 
+/* Kind of opposite to above, add firstprivate to CLAUSES_OUT if it is mapped
+   in CLAUSES_IN's FIRSTPRIVATE list but not its MAP list.  */
+
+static void
+gfc_add_firstprivate_if_unmapped (gfc_omp_clauses *clauses_out,
+				  gfc_omp_clauses *clauses_in)
+{
+  gfc_omp_namelist *n = clauses_in->lists[OMP_LIST_FIRSTPRIVATE];
+  gfc_omp_namelist **tail = NULL;
+
+  for (; n != NULL; n = n->next)
+    {
+      gfc_omp_namelist *n2 = clauses_out->lists[OMP_LIST_MAP];
+      for (; n2 != NULL; n2 = n2->next)
+	if (n->sym == n2->sym)
+	  break;
+      if (n2 == NULL)
+	{
+	  gfc_omp_namelist *dup = gfc_get_omp_namelist ();
+	  *dup = *n;
+	  dup->next = NULL;
+	  if (!tail)
+	    {
+	      tail = &clauses_out->lists[OMP_LIST_FIRSTPRIVATE];
+	      while (*tail && (*tail)->next)
+		tail = &(*tail)->next;
+	    }
+	  *tail = dup;
+	  tail = &(*tail)->next;
+	}
+    }
+}
+
 static void
 gfc_free_split_omp_clauses (gfc_code *code, gfc_omp_clauses *clausesa)
 {
@@ -6351,8 +6384,8 @@ gfc_split_omp_clauses (gfc_code *code,
 	 simd and masked/master.  Put it on the outermost of those and duplicate
 	 on parallel and teams.  */
       if (mask & GFC_OMP_MASK_TARGET)
-	clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_FIRSTPRIVATE]
-	  = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
+	gfc_add_firstprivate_if_unmapped (&clausesa[GFC_OMP_SPLIT_TARGET],
+					  code->ext.omp_clauses);
       if (mask & GFC_OMP_MASK_TEAMS)
 	clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
diff --git a/libgomp/testsuite/libgomp.fortran/combined-directive-splitting-1.f90 b/libgomp/testsuite/libgomp.fortran/combined-directive-splitting-1.f90
new file mode 100644
index 00000000000..e662a2bd3b2
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/combined-directive-splitting-1.f90
@@ -0,0 +1,41 @@
+module m
+  integer :: a = 1
+  !$omp declare target enter(a)
+end module m
+
+module m2
+contains
+subroutine bar()
+  use m
+  implicit none
+  !$omp declare target
+  a = a + 5
+end subroutine bar
+end module m2
+
+program p
+  use m
+  use m2
+  implicit none
+  integer :: b, i
+
+  !$omp target parallel do map(always, tofrom: a) firstprivate(a)
+    do i = 1, 1
+      a = 7
+      call bar()
+      if (a /= 7) error stop 1
+      a = a + 8
+    end do
+  if (a /= 6) error stop 2
+
+  b = 3
+  !$omp target parallel do map(always, tofrom: a) firstprivate(b)
+    do i = 1, 1
+      a = 3
+      call bar ()
+      if (a /= 8) error stop 3
+      a = a + b
+    end do
+  if (a /= 11) error stop 4
+end program p
+