From: Tobias Burnus <tobias@codesourcery.com>
Date: Thu, 23 Jul 2020 15:36:41 +0000 (+0200)
Subject: OpenMP: Support 'lastprivate (conditional:' in Fortran
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=084dc63a0200e60e0fbb7c36b412a158d234f5c0;p=gcc.git

OpenMP: Support 'lastprivate (conditional:' in Fortran

gcc/fortran/ChangeLog:

	* gfortran.h (gfc_omp_namelist): Add lastprivate_conditional.
	* openmp.c (gfc_match_omp_clauses): Handle 'conditional:'
	modifier of 'lastprivate'.
	* trans-openmp.c (gfc_omp_clause_default_ctor): Don't assert
	on OMP_CLAUSE__CONDTEMP_ and other OMP_*TEMP_.
	(gfc_trans_omp_variable_list): Handle lastprivate_conditional.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/lastprivate-conditional-1.f90: New test.
	* gfortran.dg/gomp/lastprivate-conditional-2.f90: New test.
	* gfortran.dg/gomp/lastprivate-conditional-3.f90: New test.
	* gfortran.dg/gomp/lastprivate-conditional-4.f90: New test.
	* gfortran.dg/gomp/lastprivate-conditional-5.f90: New test.
---

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 1648831736c..5fa86aa4e30 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1242,6 +1242,7 @@ typedef struct gfc_omp_namelist
       gfc_omp_map_op map_op;
       gfc_omp_linear_op linear_op;
       struct gfc_common_head *common;
+      bool lastprivate_conditional;
     } u;
   struct gfc_omp_namelist_udr *udr;
   struct gfc_omp_namelist *next;
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index e89ae295a31..f8f2439b6e4 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1355,10 +1355,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  break;
 	case 'l':
 	  if ((mask & OMP_CLAUSE_LASTPRIVATE)
-	      && gfc_match_omp_variable_list ("lastprivate (",
-					      &c->lists[OMP_LIST_LASTPRIVATE],
-					      true) == MATCH_YES)
-	    continue;
+	      && gfc_match ("lastprivate ( ") == MATCH_YES)
+	    {
+	      bool conditional = gfc_match ("conditional : ") == MATCH_YES;
+	      head = NULL;
+	      if (gfc_match_omp_variable_list ("",
+					       &c->lists[OMP_LIST_LASTPRIVATE],
+					       false, NULL, &head) == MATCH_YES)
+		{
+		  gfc_omp_namelist *n;
+		  for (n = *head; n; n = n->next)
+		    n->u.lastprivate_conditional = conditional;
+		  continue;
+		}
+	      gfc_current_locus = old_loc;
+	      break;
+	    }
 	  end_colon = false;
 	  head = NULL;
 	  if ((mask & OMP_CLAUSE_LINEAR)
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 56bc7cd10cc..d12d7fbddac 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -613,10 +613,21 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
   tree type = TREE_TYPE (decl), size, ptr, cond, then_b, else_b;
   stmtblock_t block, cond_block;
 
-  gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_PRIVATE
-	      || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LASTPRIVATE
-	      || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR
-	      || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION);
+  switch (OMP_CLAUSE_CODE (clause))
+    {
+    case OMP_CLAUSE__LOOPTEMP_:
+    case OMP_CLAUSE__REDUCTEMP_:
+    case OMP_CLAUSE__CONDTEMP_:
+    case OMP_CLAUSE__SCANTEMP_:
+      return NULL;
+    case OMP_CLAUSE_PRIVATE:
+    case OMP_CLAUSE_LASTPRIVATE:
+    case OMP_CLAUSE_LINEAR:
+    case OMP_CLAUSE_REDUCTION:
+      break;
+    default:
+      gcc_unreachable ();
+    }
 
   if ((! GFC_DESCRIPTOR_TYPE_P (type)
        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
@@ -1678,6 +1689,10 @@ gfc_trans_omp_variable_list (enum omp_clause_code code,
 	    tree node = build_omp_clause (input_location, code);
 	    OMP_CLAUSE_DECL (node) = t;
 	    list = gfc_trans_add_clause (node, list);
+
+	    if (code == OMP_CLAUSE_LASTPRIVATE
+		&& namelist->u.lastprivate_conditional)
+	      OMP_CLAUSE_LASTPRIVATE_CONDITIONAL (node) = 1;
 	  }
       }
   return list;
diff --git a/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-1.f90 b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-1.f90
new file mode 100644
index 00000000000..7a024061ec6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-1.f90
@@ -0,0 +1,82 @@
+subroutine foo (p)
+  implicit none
+  logical :: p(:)
+  integer a, b, c, d, e, f, g, h;
+  integer :: i
+  a = -1; b = -1; c = -1; d = -1; e = -1; f = -1; g = -1; h = -1
+  !$omp teams
+    !$omp distribute lastprivate (conditional: a) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" }
+    do i = 1, 32
+      if (p(i)) &
+        a = i
+    end do
+    !$omp distribute simd lastprivate (conditional: b) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" }
+    do i = 1, 32
+      if (p(i)) &
+        b = i
+    end do
+    !$omp distribute parallel do lastprivate (conditional: c) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" }
+    do i = 1, 32
+      if (p(i)) &
+        c = i
+    end do
+    !$omp distribute parallel do simd lastprivate (conditional: d) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" }
+    do i = 1, 32
+      if (p(i)) &
+        d = i
+    end do
+  !$omp end teams
+
+  !$omp teams distribute parallel do lastprivate (conditional: e) ! { dg-error "conditional 'lastprivate' clause on 'distribute' construct" }
+  do i = 1, 32
+    if (p(i)) &
+      e = i
+  end do
+
+  !$omp parallel
+    !$omp master
+    !$omp taskloop lastprivate (conditional: f) ! { dg-error "conditional 'lastprivate' clause on 'taskloop' construct" }
+    do i = 1, 32
+      if (p(i)) &
+        f = i
+    end do
+!    !$omp master taskloop simd lastprivate (conditional: g) ! { dg!error "conditional 'lastprivate' clause on 'taskloop' construct" }
+!    do i = 1, 32
+!      if (p(i)) &
+!        g = i
+!    end do
+    !$omp end master
+  !$omp end parallel
+
+!  !$omp parallel master taskloop simd lastprivate (conditional: h) ! { dg!error "conditional 'lastprivate' clause on 'taskloop' construct" }
+!  do i = 1, 32
+!    if (p(i)) &
+!      h = i
+!  end do
+!  !$omp end parallel master taskloop simd
+end subroutine
+
+!struct S { int a, b; };
+
+subroutine bar (p)
+  implicit none
+  logical :: p(:)
+  type s_t
+    integer :: a, b
+  end type s_t
+  type(s_t) s, t
+  integer i
+  s = s_t(-1, -1)
+  t = s_t( 1, 2)
+  !$omp parallel do lastprivate (conditional: s) ! { dg-error "non-scalar variable 's' in conditional 'lastprivate' clause" }
+  do i = 1, 32
+    if (p(i)) then
+      block
+       type(s_t) u
+       u = t
+       u%b = i
+       s = u
+      end block
+    end if
+  end do
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-2.f90 b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-2.f90
new file mode 100644
index 00000000000..5c95d8f77d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-2.f90
@@ -0,0 +1,46 @@
+! { dg-additional-options "-fdump-tree-original" }
+subroutine foo (p)
+  logical :: p(:)
+  integer i
+  integer a, b, c, d, e, f, g, h
+  a = -1; b = -1; c = -1; d = -1; e = -1; f = -1; g = -1; h = -1
+  !$omp parallel
+  !$omp do lastprivate (conditional: a)
+  do i = 1, 32
+    if (p(i)) &
+      a = i
+  end do
+  !$omp end parallel
+  !$omp simd lastprivate (conditional: b)
+  do i = 1, 32
+    if (p(i)) &
+      b = i
+  end do
+  !$omp parallel
+  !$omp do simd lastprivate (conditional: c)
+  do i = 1, 32
+    if (p(i)) &
+      c = i
+  end do
+  !$omp end parallel
+  !$omp parallel do lastprivate (conditional: d)
+  do i = 1, 32
+    if (p(i)) &
+      d = i
+  end do
+  !$omp end parallel do
+  !$omp parallel do simd lastprivate (conditional: e)
+  do i = 1, 32
+    if (p(i)) &
+      e = i
+  end do
+  !$omp end parallel do simd
+end subroutine
+
+! { dg-final { scan-tree-dump-times "#pragma omp for lastprivate\\(conditional:a\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) lastprivate\\(conditional:b\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp for lastprivate\\(conditional:c\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) lastprivate\\(conditional:c\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel lastprivate\\(conditional:d\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel lastprivate\\(conditional:e\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp simd linear\\(i:1\\) lastprivate\\(conditional:e\\)" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-3.f90 b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-3.f90
new file mode 100644
index 00000000000..720fe9b64a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-3.f90
@@ -0,0 +1,65 @@
+subroutine foo
+  integer i, j, k
+  !$omp parallel
+    !$omp do lastprivate (conditional: i)	! { dg-warning "conditional 'lastprivate' on loop iterator 'i' ignored" }
+    do i = 1, 32
+    end do
+    !$omp do collapse (3) lastprivate (conditional: i)	! { dg-warning "conditional 'lastprivate' on loop iterator 'i' ignored" }
+    do i = 1, 32
+      do j = 1, 32
+        do k = 1, 32
+        end do
+      end do
+    end do
+    !$omp do collapse (3) lastprivate (conditional: j)	! { dg-warning "conditional 'lastprivate' on loop iterator 'j' ignored" }
+    do i = 1, 32
+      do j = 1, 32
+        do k = 1, 32
+        end do
+      end do
+    end do
+    !$omp do collapse (3) lastprivate (conditional: k)	! { dg-warning "conditional 'lastprivate' on loop iterator 'k' ignored" }
+    do i = 1, 32
+      do j = 1, 32
+        do k = 1, 32
+        end do
+      end do
+    end do
+  !$omp end parallel
+
+  ! Error in eqiv. C code: "conditional 'lastprivate' on loop iterator 'i' ignored"
+  !$omp parallel do lastprivate (conditional: i)
+  do i = 1, 32
+  end do
+  !$omp end parallel do
+
+  ! Error in eqiv. C code: "conditional 'lastprivate' on loop iterator 'i' ignored"
+  !$omp parallel do collapse (3) lastprivate (conditional: i)
+  do i = 1, 32
+    do j = 1, 32
+      do k = 1, 32
+      end do
+    end do
+  end do
+  !$omp end parallel do
+
+  ! Error in eqiv. C code: "conditional 'lastprivate' on loop iterator 'j' ignored"
+  !$omp parallel do collapse (3) lastprivate (conditional: j)
+  do i = 1, 32
+    do j = 1, 32
+      do k = 1, 32
+      end do
+    end do
+  end do
+  !$omp end parallel do
+
+  ! Error in eqiv. C code: "conditional 'lastprivate' on loop iterator 'k' ignored"
+  !$omp parallel do collapse (3) lastprivate (conditional: k)
+  do i = 1, 32
+    do j = 1, 32
+      do k = 1, 32
+      end do
+    end do
+  end do
+  !$omp end parallel do
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-4.f90 b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-4.f90
new file mode 100644
index 00000000000..1e8c6c7e41a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-4.f90
@@ -0,0 +1,28 @@
+module m
+integer x, w
+end module m
+
+subroutine foo
+  use m
+  interface
+    logical function bar(i)
+      integer i
+    end function
+  end interface
+  integer y, i, z
+  logical tmp
+  y = 5
+  !$omp teams num_teams(1) firstprivate (x) shared (y) shared (w)
+    !$omp parallel do firstprivate (x, y, z, w) lastprivate (conditional: x, y, z, w)
+    do i = 1, 64
+      if (bar (i)) then
+        x = i;
+        y = i + 1;
+        z = i + 2;
+        w = i + 3;
+      end if
+      tmp = bar (y);
+      tmp = bar (z);
+    end do
+  !$omp end teams
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-5.f90 b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-5.f90
new file mode 100644
index 00000000000..e2f3cb7dd90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/lastprivate-conditional-5.f90
@@ -0,0 +1,47 @@
+! { dg-do compile }
+! { dg-options "-O2 -fopenmp -fdump-tree-ompexp" }
+! { dg-final { scan-tree-dump-times "GOMP_loop_start " 3 "ompexp" } }
+! { dg-final { scan-tree-dump-times "GOMP_loop_end_nowait " 3 "ompexp" } }
+
+module m
+  logical r
+end module m
+
+subroutine foo (a)
+  use m
+  implicit none
+  logical a(:)
+  integer :: i
+  !$omp do lastprivate(conditional: r)
+  do i = 1, 64
+    if (a(i)) &
+      r = a(i)
+  end do
+  !$omp end do nowait
+end
+
+subroutine bar (a)
+  use m
+  implicit none
+  logical a(:)
+  integer :: i
+  !$omp do lastprivate(conditional: r) schedule (static, 4)
+  do i = 1, 64
+    if (a(i)) &
+      r = a(i)
+  end do
+  !$omp end do nowait
+end
+
+subroutine baz (a)
+  use m
+  implicit none
+  logical a(:)
+  integer :: i
+  !$omp do lastprivate(conditional: r) schedule (runtime)
+  do i = 1, 64
+    if (a(i)) &
+      r = a(i)
+  end do
+  !$omp end do nowait
+end