This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[gomp4.5] Doacross fixes for Fortran non-simple loops


Hi!

This fixes the handling of doacross on non-simple Fortran loops (ones where
step isn't compile time known 1 or -1), except that lastprivate is still
broken if the collapsed loop iterates non-zero times, but one of the ordered
loops inside of it has zero iterations.  Will need to figure out something
for that case.

Tested on x86_64-linux and i686-linux, committed to gomp-4_5-branch.

2016-05-30  Jakub Jelinek  <jakub@redhat.com>

	* omp-low.c (expand_omp_ordered_sink): Handle TREE_PURPOSE
	of deps being TRUNC_DIV_EXPR.
	* gimplify.c (gimplify_scan_omp_clauses): Likewise.
gcc/fortran/
	* trans-openmp.c (doacross_steps): New variable.
	(gfc_trans_omp_clauses): Wrap depend sink addend into
	TRUNC_DIV_EXPR with second operand the non-simple step.
	(gfc_trans_omp_do): Set up doacross_steps.
libgomp/
	* testsuite/libgomp.c/doacross-1.c (main): Add missing
	#pragma omp atomic read.
	* testsuite/libgomp.c/doacross-2.c (main): Likewise.
	* testsuite/libgomp.c/doacross-3.c (main): Likewise.
	* testsuite/libgomp.fortran/doacross1.f90: New test.
	* testsuite/libgomp.fortran/doacross2.f90: New test.

--- gcc/omp-low.c.jj	2016-05-20 14:52:59.000000000 +0200
+++ gcc/omp-low.c	2016-05-30 17:46:40.239706984 +0200
@@ -7996,12 +7996,27 @@ expand_omp_ordered_sink (gimple_stmt_ite
 
   for (i = 0; i < fd->ordered; i++)
     {
+      tree step = NULL_TREE;
       off = TREE_PURPOSE (deps);
+      if (TREE_CODE (off) == TRUNC_DIV_EXPR)
+	{
+	  step = TREE_OPERAND (off, 1);
+	  off = TREE_OPERAND (off, 0);
+	}
       if (!integer_zerop (off))
 	{
 	  gcc_assert (fd->loops[i].cond_code == LT_EXPR
 		      || fd->loops[i].cond_code == GT_EXPR);
 	  bool forward = fd->loops[i].cond_code == LT_EXPR;
+	  if (step)
+	    {
+	      /* Non-simple Fortran DO loops.  If step is variable,
+		 we don't know at compile even the direction, so can't
+		 warn.  */
+	      if (TREE_CODE (step) != INTEGER_CST)
+		break;
+	      forward = tree_int_cst_sgn (step) != -1;
+	    }
 	  if (forward ^ OMP_CLAUSE_DEPEND_SINK_NEGATIVE (deps))
 	    warning_at (loc, 0, "%<depend(sink)%> clause waiting for "
 				"lexically later iteration");
@@ -8022,16 +8037,33 @@ expand_omp_ordered_sink (gimple_stmt_ite
   edge e1 = split_block (gsi_bb (gsi2), gsi_stmt (gsi2));
   edge e2 = split_block_after_labels (e1->dest);
 
-  *gsi = gsi_after_labels (e1->dest);
+  gsi2 = gsi_after_labels (e1->dest);
+  *gsi = gsi_last_bb (e1->src);
   for (i = 0; i < fd->ordered; i++)
     {
       tree itype = TREE_TYPE (fd->loops[i].v);
+      tree step = NULL_TREE;
+      tree orig_off = NULL_TREE;
       if (POINTER_TYPE_P (itype))
 	itype = sizetype;
       if (i)
 	deps = TREE_CHAIN (deps);
       off = TREE_PURPOSE (deps);
-      tree s = fold_convert_loc (loc, itype, fd->loops[i].step);
+      if (TREE_CODE (off) == TRUNC_DIV_EXPR)
+	{
+	  step = TREE_OPERAND (off, 1);
+	  off = TREE_OPERAND (off, 0);
+	  gcc_assert (fd->loops[i].cond_code == LT_EXPR
+		      && integer_onep (fd->loops[i].step)
+		      && !POINTER_TYPE_P (TREE_TYPE (fd->loops[i].v)));
+	}
+      tree s = fold_convert_loc (loc, itype, step ? step : fd->loops[i].step);
+      if (step)
+	{
+	  off = fold_convert_loc (loc, itype, off);
+	  orig_off = off;
+	  off = fold_build2_loc (loc, TRUNC_DIV_EXPR, itype, off, s);
+	}
 
       if (integer_zerop (off))
 	t = boolean_true_node;
@@ -8053,7 +8085,36 @@ expand_omp_ordered_sink (gimple_stmt_ite
 	  else
 	    a = fold_build2_loc (loc, PLUS_EXPR, TREE_TYPE (fd->loops[i].v),
 				 fd->loops[i].v, co);
-	  if (fd->loops[i].cond_code == LT_EXPR)
+	  if (step)
+	    {
+	      tree t1, t2;
+	      if (OMP_CLAUSE_DEPEND_SINK_NEGATIVE (deps))
+		t1 = fold_build2_loc (loc, GE_EXPR, boolean_type_node, a,
+				      fd->loops[i].n1);
+	      else
+		t1 = fold_build2_loc (loc, LT_EXPR, boolean_type_node, a,
+				      fd->loops[i].n2);
+	      if (OMP_CLAUSE_DEPEND_SINK_NEGATIVE (deps))
+		t2 = fold_build2_loc (loc, LT_EXPR, boolean_type_node, a,
+				      fd->loops[i].n2);
+	      else
+		t2 = fold_build2_loc (loc, GE_EXPR, boolean_type_node, a,
+				      fd->loops[i].n1);
+	      t = fold_build2_loc (loc, LT_EXPR, boolean_type_node,
+				   step, build_int_cst (TREE_TYPE (step), 0));
+	      if (TREE_CODE (step) != INTEGER_CST)
+		{
+		  t1 = unshare_expr (t1);
+		  t1 = force_gimple_operand_gsi (gsi, t1, true, NULL_TREE,
+						 false, GSI_CONTINUE_LINKING);
+		  t2 = unshare_expr (t2);
+		  t2 = force_gimple_operand_gsi (gsi, t2, true, NULL_TREE,
+						 false, GSI_CONTINUE_LINKING);
+		}
+	      t = fold_build3_loc (loc, COND_EXPR, boolean_type_node,
+				   t, t2, t1);
+	    }
+	  else if (fd->loops[i].cond_code == LT_EXPR)
 	    {
 	      if (OMP_CLAUSE_DEPEND_SINK_NEGATIVE (deps))
 		t = fold_build2_loc (loc, GE_EXPR, boolean_type_node, a,
@@ -8076,16 +8137,20 @@ expand_omp_ordered_sink (gimple_stmt_ite
 
       off = fold_convert_loc (loc, itype, off);
 
-      if (fd->loops[i].cond_code == LT_EXPR
-	  ? !integer_onep (fd->loops[i].step)
-	  : !integer_minus_onep (fd->loops[i].step))
+      if (step
+	  || (fd->loops[i].cond_code == LT_EXPR
+	      ? !integer_onep (fd->loops[i].step)
+	      : !integer_minus_onep (fd->loops[i].step)))
 	{
-	  if (TYPE_UNSIGNED (itype) && fd->loops[i].cond_code == GT_EXPR)
+	  if (step == NULL_TREE
+	      && TYPE_UNSIGNED (itype)
+	      && fd->loops[i].cond_code == GT_EXPR)
 	    t = fold_build2_loc (loc, TRUNC_MOD_EXPR, itype, off,
 				 fold_build1_loc (loc, NEGATE_EXPR, itype,
 						  s));
 	  else
-	    t = fold_build2_loc (loc, TRUNC_MOD_EXPR, itype, off, s);
+	    t = fold_build2_loc (loc, TRUNC_MOD_EXPR, itype,
+				 orig_off ? orig_off : off, s);
 	  t = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, t,
 			       build_int_cst (itype, 0));
 	  if (integer_zerop (t) && !warned_step)
@@ -8108,7 +8173,9 @@ expand_omp_ordered_sink (gimple_stmt_ite
 			       fd->loops[i].v, fd->loops[i].n1);
 	  t = fold_convert_loc (loc, fd->iter_type, t);
 	}
-      if (TYPE_UNSIGNED (itype) && fd->loops[i].cond_code == GT_EXPR)
+      if (step)
+	/* We have divided off by step already earlier.  */;
+      else if (TYPE_UNSIGNED (itype) && fd->loops[i].cond_code == GT_EXPR)
 	off = fold_build2_loc (loc, TRUNC_DIV_EXPR, itype, off,
 			       fold_build1_loc (loc, NEGATE_EXPR, itype,
 						s));
@@ -8131,15 +8198,14 @@ expand_omp_ordered_sink (gimple_stmt_ite
 	}
       off = unshare_expr (off);
       t = fold_build2_loc (loc, PLUS_EXPR, fd->iter_type, t, off);
-      t = force_gimple_operand_gsi (gsi, t, true, NULL_TREE,
+      t = force_gimple_operand_gsi (&gsi2, t, true, NULL_TREE,
 				    true, GSI_SAME_STMT);
       args.safe_push (t);
     }
   gimple *g = gimple_build_call_vec (builtin_decl_explicit (sink_ix), args);
   gimple_set_location (g, loc);
-  gsi_insert_before (gsi, g, GSI_SAME_STMT);
+  gsi_insert_before (&gsi2, g, GSI_SAME_STMT);
 
-  *gsi = gsi_last_bb (e1->src);
   cond = unshare_expr (cond);
   cond = force_gimple_operand_gsi (gsi, cond, true, NULL_TREE, false,
 				   GSI_CONTINUE_LINKING);
--- gcc/gimplify.c.jj	2016-05-20 17:34:28.000000000 +0200
+++ gcc/gimplify.c	2016-05-27 18:32:16.441571866 +0200
@@ -7177,13 +7177,20 @@ gimplify_scan_omp_clauses (tree *list_p,
 	  goto do_add;
 
 	case OMP_CLAUSE_DEPEND:
-	  if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK
-	      || OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SOURCE)
+	  if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK)
 	    {
-	      /* Nothing to do.  OMP_CLAUSE_DECL will be lowered in
-		 omp-low.c.  */
-	      break;
+	      tree deps = OMP_CLAUSE_DECL (c);
+	      while (deps && TREE_CODE (deps) == TREE_LIST)
+		{
+		  if (TREE_CODE (TREE_PURPOSE (deps)) == TRUNC_DIV_EXPR
+		      && DECL_P (TREE_OPERAND (TREE_PURPOSE (deps), 1)))
+		    gimplify_expr (&TREE_OPERAND (TREE_PURPOSE (deps), 1),
+				   pre_p, NULL, is_gimple_val, fb_rvalue);
+		  deps = TREE_CHAIN (deps);
+		}
 	    }
+	  else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SOURCE)
+	    break;
 	  if (TREE_CODE (OMP_CLAUSE_DECL (c)) == COMPOUND_EXPR)
 	    {
 	      gimplify_expr (&TREE_OPERAND (OMP_CLAUSE_DECL (c), 0), pre_p,
--- gcc/fortran/trans-openmp.c.jj	2016-05-27 11:45:55.000000000 +0200
+++ gcc/fortran/trans-openmp.c	2016-05-30 11:47:06.667203331 +0200
@@ -1754,6 +1754,8 @@ gfc_convert_expr_to_tree (stmtblock_t *b
   return result;
 }
 
+static vec<tree, va_heap, vl_embed> *doacross_steps;
+
 static tree
 gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		       locus where, bool declare_simd = false)
@@ -1930,7 +1932,8 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
 	      if (n->u.depend_op == OMP_DEPEND_SINK_FIRST)
 		{
 		  tree vec = NULL_TREE;
-		  while (1)
+		  unsigned int i;
+		  for (i = 0; ; i++)
 		    {
 		      tree addend = integer_zero_node, t;
 		      bool neg = false;
@@ -1948,6 +1951,15 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
 		      t = gfc_trans_omp_variable (n->sym, false);
 		      if (t != error_mark_node)
 			{
+			  if (i < vec_safe_length (doacross_steps)
+			      && !integer_zerop (addend)
+			      && (*doacross_steps)[i])
+			    {
+			      tree step = (*doacross_steps)[i];
+			      addend = fold_convert (TREE_TYPE (step), addend);
+			      addend = build2 (TRUNC_DIV_EXPR,
+					       TREE_TYPE (step), addend, step);
+			    }
 			  vec = tree_cons (addend, t, vec);
 			  if (neg)
 			    OMP_CLAUSE_DEPEND_SINK_NEGATIVE (vec) = 1;
@@ -3431,7 +3443,9 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex
   vec<dovar_init> inits = vNULL;
   dovar_init *di;
   unsigned ix;
+  vec<tree, va_heap, vl_embed> *saved_doacross_steps = doacross_steps;
 
+  doacross_steps = NULL;
   if (clauses->orderedc)
     collapse = clauses->orderedc;
   if (collapse <= 0)
@@ -3568,6 +3582,12 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex
 	  tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp);
 	  dovar_init e = {dovar, tmp};
 	  inits.safe_push (e);
+	  if (clauses->orderedc)
+	    {
+	      if (doacross_steps == NULL)
+		vec_safe_grow_cleared (doacross_steps, clauses->orderedc);
+	      (*doacross_steps)[i] = step;
+	    }
 	}
       if (orig_decls)
 	TREE_VEC_ELT (orig_decls, i) = dovar_decl;
@@ -3728,6 +3748,9 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex
     OMP_FOR_ORIG_DECLS (stmt) = orig_decls;
   gfc_add_expr_to_block (&block, stmt);
 
+  vec_free (doacross_steps);
+  doacross_steps = saved_doacross_steps;
+
   return gfc_finish_block (&block);
 }
 
--- libgomp/testsuite/libgomp.c/doacross-1.c.jj	2015-10-14 10:24:10.000000000 +0200
+++ libgomp/testsuite/libgomp.c/doacross-1.c	2016-05-30 12:25:44.488068374 +0200
@@ -96,6 +96,7 @@ main ()
 				  depend(sink: i - 1, j - 2, k - 2 E(m))
 	      if (k <= 4)
 		{
+		  #pragma omp atomic read
 		  l = c[i][j][k + 2];
 		  if (l < 2)
 		    abort ();
@@ -104,12 +105,14 @@ main ()
 	      c[i][j][k] = 2;
 	      if (i >= 2 && j < 7 && k >= 4)
 		{
+		  #pragma omp atomic read
 		  l = c[i - 2][j + 1][k - 4];
 		  if (l < 2)
 		    abort ();
 		}
 	      if (i >= 1 && j >= 4 && k >= 2)
 		{
+		  #pragma omp atomic read
 		  l = c[i - 1][j - 2][k - 2];
 		  if (l < 2)
 		    abort ();
--- libgomp/testsuite/libgomp.c/doacross-2.c.jj	2015-10-14 10:24:10.000000000 +0200
+++ libgomp/testsuite/libgomp.c/doacross-2.c	2016-05-30 12:26:15.291674414 +0200
@@ -98,6 +98,7 @@ main ()
 				  depend(sink: i - 1, j - 2, k - 2 E(m))
 	      if (k <= 4)
 		{
+		  #pragma omp atomic read
 		  l = c[i][j][k + 2];
 		  if (l < 2)
 		    abort ();
@@ -106,12 +107,14 @@ main ()
 	      c[i][j][k] = 2;
 	      if (i >= 4 && j < 7 && k >= 4)
 		{
+		  #pragma omp atomic read
 		  l = c[i - 2][j + 1][k - 4];
 		  if (l < 2)
 		    abort ();
 		}
 	      if (i >= 3 && j >= 4 && k >= 2)
 		{
+		  #pragma omp atomic read
 		  l = c[i - 1][j - 2][k - 2];
 		  if (l < 2)
 		    abort ();
--- libgomp/testsuite/libgomp.c/doacross-3.c.jj	2015-11-13 19:09:01.000000000 +0100
+++ libgomp/testsuite/libgomp.c/doacross-3.c	2016-05-30 12:26:36.091408397 +0200
@@ -98,6 +98,7 @@ main ()
 				  depend(sink: i - 1, j - 2, k - 2 E(m))
 	      if (k <= 4)
 		{
+		  #pragma omp atomic read
 		  l = c[i][j][k + 2];
 		  if (l < 2)
 		    abort ();
@@ -106,12 +107,14 @@ main ()
 	      c[i][j][k] = 2;
 	      if (i >= 4 && j < 7 && k >= 4)
 		{
+		  #pragma omp atomic read
 		  l = c[i - 2][j + 1][k - 4];
 		  if (l < 2)
 		    abort ();
 		}
 	      if (i >= 3 && j >= 4 && k >= 2)
 		{
+		  #pragma omp atomic read
 		  l = c[i - 1][j - 2][k - 2];
 		  if (l < 2)
 		    abort ();
--- libgomp/testsuite/libgomp.fortran/doacross1.f90.jj	2016-05-30 16:46:42.418992539 +0200
+++ libgomp/testsuite/libgomp.fortran/doacross1.f90	2016-05-30 16:46:57.196801044 +0200
@@ -0,0 +1,209 @@
+! { dg-do run }
+
+  integer, parameter :: N = 256
+  integer, save :: a(N), b(N / 16, 8, 4), c(N / 32, 8, 8)
+  integer, save, volatile :: d, e
+  integer :: i, j, k, l, m
+  integer :: m1, m2, m3, m4, m5, m6, m7, m8
+  integer :: m9, m10, m11, m12, m13, m14, m15, m16
+  d = 0
+  e = 0
+  !$omp parallel private (l) shared(k)
+    !$omp do schedule(static, 1) ordered(1)
+    do i = 1, N
+      !$omp atomic write
+      a(i) = 1
+      !$omp ordered depend ( sink : i - 1 )
+      if (i.gt.1) then
+        !$omp atomic read
+        l = a(i - 1)
+        if (l.lt.2) call abort
+      end if
+      !$omp atomic write
+      a(i) = 2
+      if (i.lt.N) then
+        !$omp atomic read
+        l = a(i + 1)
+        if (l.eq.3) call abort
+      end if
+      !$omp ordered depend(source)
+      !$omp atomic write
+      a(i) = 3
+    end do
+    !$omp end do nowait
+    !$omp do schedule(static) ordered ( 3 )
+    do i = 3, N / 16 - 1
+      do j = 1, 8, 2
+        do k = 2, 4
+          !$omp atomic write
+          b(i, j, k) = 1
+          !$omp ordered depend(sink:i,j-2,k-1) &
+          !$omp& depend(sink: i - 2, j - 2, k + 1)
+          !$omp ordered depend(sink:i-3,j+2,k-2)
+          if (j.gt.2.and.k.gt.2) then
+            !$omp atomic read
+            l = b(i,j-2,k-1)
+            if (l.lt.2) call abort
+          end if
+          !$omp atomic write
+          b(i,j,k) = 2
+          if (i.gt.4.and.j.gt.2.and.k.lt.4) then
+            !$omp atomic read
+            l = b(i-2,j-2, k+1)
+            if (l.lt.2) call abort
+          end if
+          if (i.gt.5.and.j.le.N/16-3.and.k.eq.4) then
+            !$omp atomic read
+            l = b( i - 3, j+2, k-2)
+            if (l.lt.2) call abort
+          end if
+          !$omp ordered depend(source)
+          !$omp atomic write
+          b(i, j, k) = 3
+        end do
+      end do
+    end do
+    !$omp end do nowait
+    !$omp do schedule(dynamic, 15) collapse(2) ordered(13)
+    do i = 1, N / 32
+      do j = 8, 3, -1
+        do k = 7, 1, -2
+          do m1 = 4, 4
+          do m2 = 4, 4
+          do m3 = 4, 4
+          do m4 = 4, 4
+          do m5 = 4, 4
+          do m6 = 4, 4
+          do m7 = 4, 4
+          do m8 = 4, 4
+          do m9 = 4, 4
+          do m10 = 4, 4
+          do m11 = 4, 4
+          do m12 = 4, 4
+          do m13 = 4, 4
+          do m14 = 4, 4
+          do m15 = 4, 4
+          do m16 = 4, 4
+            !$omp atomic write
+            c(i, j, k) = 1
+            !$omp ordered depend(sink: i, j, k + 2, m1, m2, m3, m4, &
+            !$omp & m5, m6, m7, m8, m9, m10) &
+            !$omp depend(sink: i - 2, j + 1, k - 4, m1,m2,m3,m4,m5, &
+            !$omp & m6,m7,m8,m9,m10) depend ( sink : i-1,j-2,k-2, &
+            !$omp& m1,m2,m3,m4 , m5, m6,m7,m8,m9,m10 )
+            if (k.le.5) then
+              !$omp atomic read
+              l = c(i, j, k + 2)
+              if (l.lt.2) call abort
+            end if
+            !$omp atomic write
+            c(i, j, k) = 2
+            if (i.ge.3.and.j.lt.8.and.k.ge.5) then
+              !$omp atomic read
+              l = c(i - 2, j + 1, k - 4)
+              if (l.lt.2) call abort
+            end if
+            if (i.ge.2.and.j.ge.5.and.k.ge.3) then
+              !$omp atomic read
+              l = c(i - 1, j - 2, k - 2)
+              if (l.lt.2) call abort
+            end if
+            !$omp ordered depend ( source )
+            !$omp atomic write
+            c(i,j,k)=3
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+        end do
+      end do
+    end do
+    !$omp do collapse(2) ordered(4) lastprivate (i,j,k)
+    do i = 0, d
+      do j = d + 1, 0, -1
+        do k = 0, d - 1
+          do l = 0, d + 1
+            !$omp ordered depend(source)
+            !$omp ordered depend(sink: i-2,j+2,k-2,l)
+            if (e.eq.0) call abort
+          end do
+        end do
+      end do
+    end do
+    !$omp single
+    if (i.ne.1.or.j.ne.-1.or.k.ne.0) call abort
+    i = 8; j = 9; k = 10
+    !$omp end single
+    !$omp do ordered(4) collapse(2) lastprivate (i, j, k, m)
+    do i = 0, d
+      do j = d + 1, 0, -1
+        do k = 0, d + 1
+          do m = 0, d-1
+            !$omp ordered depend(source)
+            !$omp ordered depend(sink: i - 2, j + 2, k - 2, m)
+            call abort
+          end do
+        end do
+      end do
+    end do
+    !$omp single
+    if (i.ne.1.or.j.ne.-1.or.k.ne.2.or.m.ne.0) call abort
+    !$omp end single
+    !$omp do collapse(2) ordered(4) lastprivate (i,j,k)
+    do i = 0, d
+      do j = d, 1, -1
+        do k = 0, d + 1
+          do l = 0, d + 3
+            !$omp ordered depend(source)
+            !$omp ordered depend(sink: i-2,j+2,k-2,l)
+            if (e.eq.0) call abort
+          end do
+        end do
+      end do
+    end do
+    !$omp end do nowait
+    !$omp do
+    do i = 1, N
+      if (a(i) .ne. 3) call abort
+    end do
+    !$omp end do nowait
+    !$omp do collapse(2) private(k)
+    do i = 1, N / 16
+      do j = 1, 8
+        do k = 1, 4
+          if (i.ge.3.and.i.lt.N/16.and.iand(j,1).ne.0.and.k.ge.2) then
+            if (b(i,j,k).ne.3) call abort
+          else
+            if (b(i,j,k).ne.0) call abort
+          end if
+        end do
+      end do
+    end do
+    !$omp end do nowait
+    !$omp do collapse(3)
+    do i = 1, N / 32
+      do j = 1, 8
+        do k = 1, 4
+          if (j.ge.3.and.iand(k,1).ne.0) then
+            if (c(i,j,k).ne.3) call abort
+          else
+            if (c(i,j,k).ne.0) call abort
+          end if
+        end do
+      end do
+    end do
+    !$omp end do nowait
+  !$omp end parallel
+end
--- libgomp/testsuite/libgomp.fortran/doacross2.f90.jj	2016-05-30 17:30:38.244050776 +0200
+++ libgomp/testsuite/libgomp.fortran/doacross2.f90	2016-05-30 17:30:46.729942019 +0200
@@ -0,0 +1,261 @@
+! { dg-do run }
+
+  integer, parameter :: N = 256
+  integer, save :: a(N), b(N / 16, 8, 4), c(N / 32, 8, 8), g(N/16,8,6)
+  integer, save, volatile :: d, e
+  integer(kind=8), save, volatile :: f
+  integer(kind=8) :: i
+  integer :: j, k, l, m
+  integer :: m1, m2, m3, m4, m5, m6, m7, m8
+  integer :: m9, m10, m11, m12, m13, m14, m15, m16
+  d = 0
+  e = 0
+  f = 0
+  !$omp parallel private (l) shared(k)
+    !$omp do schedule(static, 1) ordered(1)
+    do i = 2, N + f
+      !$omp atomic write
+      a(i) = 1
+      !$omp ordered depend ( sink : i - 1 )
+      if (i.gt.2) then
+        !$omp atomic read
+        l = a(i - 1)
+        if (l.lt.2) call abort
+      end if
+      !$omp atomic write
+      a(i) = 2
+      if (i.lt.N) then
+        !$omp atomic read
+        l = a(i + 1)
+        if (l.eq.3) call abort
+      end if
+      !$omp ordered depend(source)
+      !$omp atomic write
+      a(i) = 3
+    end do
+    !$omp end do nowait
+    !$omp do schedule(static) ordered ( 3 )
+    do i = 4, N / 16 - 1 + f
+      do j = 1, 8, 2
+        do k = 2, 4
+          !$omp atomic write
+          b(i, j, k) = 1
+          !$omp ordered depend(sink:i,j-2,k-1) &
+          !$omp& depend(sink: i - 2, j - 2, k + 1)
+          !$omp ordered depend(sink:i-3,j+2,k-2)
+          if (j.gt.2.and.k.gt.2) then
+            !$omp atomic read
+            l = b(i,j-2,k-1)
+            if (l.lt.2) call abort
+          end if
+          !$omp atomic write
+          b(i,j,k) = 2
+          if (i.gt.5.and.j.gt.2.and.k.lt.4) then
+            !$omp atomic read
+            l = b(i-2,j-2, k+1)
+            if (l.lt.2) call abort
+          end if
+          if (i.gt.6.and.j.le.N/16-3.and.k.eq.4) then
+            !$omp atomic read
+            l = b( i - 3, j+2, k-2)
+            if (l.lt.2) call abort
+          end if
+          !$omp ordered depend(source)
+          !$omp atomic write
+          b(i, j, k) = 3
+        end do
+      end do
+    end do
+    !$omp end do nowait
+    !$omp do schedule(dynamic, 15) collapse(2) ordered(13)
+    do i = 3, N / 32 + f
+      do j = 8, 3, -1
+        do k = 7, 1, -2
+          do m1 = 4, 4
+          do m2 = 4, 4
+          do m3 = 4, 4
+          do m4 = 4, 4
+          do m5 = 4, 4
+          do m6 = 4, 4
+          do m7 = 4, 4
+          do m8 = 4, 4
+          do m9 = 4, 4
+          do m10 = 4, 4
+          do m11 = 4, 4
+          do m12 = 4, 4
+          do m13 = 4, 4
+          do m14 = 4, 4
+          do m15 = 4, 4
+          do m16 = 4, 4
+            !$omp atomic write
+            c(i, j, k) = 1
+            !$omp ordered depend(sink: i, j, k + 2, m1, m2, m3, m4, &
+            !$omp & m5, m6, m7, m8, m9, m10) &
+            !$omp depend(sink: i - 2, j + 1, k - 4, m1,m2,m3,m4,m5, &
+            !$omp & m6,m7,m8,m9,m10) depend ( sink : i-1,j-2,k-2, &
+            !$omp& m1,m2,m3,m4 , m5, m6,m7,m8,m9,m10 )
+            if (k.le.5) then
+              !$omp atomic read
+              l = c(i, j, k + 2)
+              if (l.lt.2) call abort
+            end if
+            !$omp atomic write
+            c(i, j, k) = 2
+            if (i.ge.5.and.j.lt.8.and.k.ge.5) then
+              !$omp atomic read
+              l = c(i - 2, j + 1, k - 4)
+              if (l.lt.2) call abort
+            end if
+            if (i.ge.4.and.j.ge.5.and.k.ge.3) then
+              !$omp atomic read
+              l = c(i - 1, j - 2, k - 2)
+              if (l.lt.2) call abort
+            end if
+            !$omp ordered depend ( source )
+            !$omp atomic write
+            c(i,j,k)=3
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+          end do
+        end do
+      end do
+    end do
+    !$omp do schedule(static) ordered(3)
+    do j = 1, N / 16 - 1
+      do k = 1, 7, 2
+        do i = 4, 6 + f
+          !$omp atomic write
+          g(j, k, i) = 1
+          !$omp ordered depend(sink: j, k-2,i-1) &
+          !$omp& depend(sink: j - 2, k - 2, i + 1)
+          !$omp ordered depend(sink:j-3,k+2,i-2)
+          if (k.gt.2.and.i.gt.4) then
+            !$omp atomic read
+            l = g(j,k-2,i-1)
+            if (l.lt.2) call abort
+          end if
+          !$omp atomic write
+          g(j,k,i) = 2
+          if (j.gt.2.and.k.gt.2.and.i.lt.6) then
+            !$omp atomic read
+            l = g(j-2,k-2, i+1)
+            if (l.lt.2) call abort
+          end if
+          if (j.gt.3.and.k.le.N/16-3.and.i.eq.6) then
+            !$omp atomic read
+            l = g( j - 3, k+2, i-2)
+            if (l.lt.2) call abort
+          end if
+          !$omp ordered depend(source)
+          !$omp atomic write
+          g(j, k, i) = 3
+        end do
+      end do
+    end do
+    !$omp end do nowait
+    !$omp do collapse(2) ordered(4) lastprivate (i,j,k)
+    do i = 2, f + 2
+      do j = d + 1, 0, -1
+        do k = 0, d - 1
+          do l = 0, d + 1
+            !$omp ordered depend(source)
+            !$omp ordered depend(sink: i-2,j+2,k-2,l)
+            if (e.eq.0) call abort
+          end do
+        end do
+      end do
+    end do
+    !$omp single
+    if (i.ne.3.or.j.ne.-1.or.k.ne.0) call abort
+    i = 8; j = 9; k = 10
+    !$omp end single
+    !$omp do ordered(4) collapse(2) lastprivate (i, j, k, m)
+    do i = 2, f + 2
+      do j = d + 1, 0, -1
+        do k = 0, d + 1
+          do m = 0, d-1
+            !$omp ordered depend(source)
+            !$omp ordered depend(sink: i - 2, j + 2, k - 2, m)
+            call abort
+          end do
+        end do
+      end do
+    end do
+    !$omp single
+    if (i.ne.3.or.j.ne.-1.or.k.ne.2.or.m.ne.0) call abort
+    !$omp end single
+    !$omp do collapse(2) ordered(4) lastprivate (i,j,k)
+    do i = 2, f + 2
+      do j = d, 1, -1
+        do k = 0, d + 1
+          do l = 0, d + 3
+            !$omp ordered depend(source)
+            !$omp ordered depend(sink: i-2,j+2,k-2,l)
+            if (e.eq.0) call abort
+          end do
+        end do
+      end do
+    end do
+    !$omp end do nowait
+    !$omp single
+    if (a(1) .ne. 0) call abort
+    !$omp end single nowait
+    !$omp do
+    do i = 2, N
+      if (a(i) .ne. 3) call abort
+    end do
+    !$omp end do nowait
+    !$omp do collapse(2) private(k)
+    do i = 1, N / 16
+      do j = 1, 8
+        do k = 1, 4
+          if (i.ge.4.and.i.lt.N/16.and.iand(j,1).ne.0.and.k.ge.2) then
+            if (b(i,j,k).ne.3) call abort
+          else
+            if (b(i,j,k).ne.0) call abort
+          end if
+        end do
+      end do
+    end do
+    !$omp end do nowait
+    !$omp do collapse(3)
+    do i = 1, N / 32
+      do j = 1, 8
+        do k = 1, 4
+          if (i.ge.3.and.j.ge.3.and.iand(k,1).ne.0) then
+            if (c(i,j,k).ne.3) call abort
+          else
+            if (c(i,j,k).ne.0) call abort
+          end if
+        end do
+      end do
+    end do
+    !$omp end do nowait
+    !$omp do collapse(2) private(k)
+    do i = 1, N / 16
+      do j = 1, 8
+        do k = 1, 6
+          if (i.lt.N/16.and.iand(j,1).ne.0.and.k.ge.4) then
+            if (g(i,j,k).ne.3) call abort
+          else
+            if (g(i,j,k).ne.0) call abort
+          end if
+        end do
+      end do
+    end do
+    !$omp end do nowait
+  !$omp end parallel
+end

	Jakub


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]