OpenMP/Fortran: Partially fix non-rect loop nests [PR107424]

This patch ensures that loop bounds depending on outer loop vars use the
proper TREE_VEC format. It additionally gives a sorry if such an outer
var has a non-one/non-minus-one increment as currently a count variable
is used in this case (see PR).

Finally, it avoids 'count' and just uses a local loop variable if the
step increment is +/-1.

	PR fortran/107424

gcc/fortran/ChangeLog:

	* trans-openmp.cc (struct dovar_init_d): Add 'sym' and
	'non_unit_incr' members.
	(gfc_nonrect_loop_expr): New.
	(gfc_trans_omp_do): Call it; use normal loop bounds
	for unit stride - and only create local loop var.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/non-rectangular-loop-1.f90: New test.
	* testsuite/libgomp.fortran/non-rectangular-loop-1a.f90: New test.
	* testsuite/libgomp.fortran/non-rectangular-loop-2.f90: New test.
	* testsuite/libgomp.fortran/non-rectangular-loop-3.f90: New test.
	* testsuite/libgomp.fortran/non-rectangular-loop-4.f90: New test.
	* testsuite/libgomp.fortran/non-rectangular-loop-5.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/goacc/privatization-1-compute-loop.f90: Update dg-note.
	* gfortran.dg/goacc/privatization-1-routine_gang-loop.f90: Likewise.

1 files changed, 195 insertions, 46 deletions

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 5283d0c..2d16f3b 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -5116,10 +5116,138 @@ gfc_trans_omp_critical (gfc_code *code)
 }
 
 typedef struct dovar_init_d {
+  gfc_symbol *sym;
   tree var;
   tree init;
+  bool non_unit_iter;
 } dovar_init;
 
+static bool
+gfc_nonrect_loop_expr (stmtblock_t *pblock, gfc_se *sep, int loop_n,
+		       gfc_code *code, gfc_expr *expr, vec<dovar_init> *inits,
+		       int simple, gfc_expr *curr_loop_var)
+{
+  int i;
+  for (i = 0; i < loop_n; i++)
+    {
+      gcc_assert (code->ext.iterator->var->expr_type == EXPR_VARIABLE);
+      if (gfc_find_sym_in_expr (code->ext.iterator->var->symtree->n.sym, expr))
+	break;
+      code = code->block->next;
+    }
+  if (i >= loop_n)
+    return false;
+
+  /* Canonical format: TREE_VEC with [var, multiplier, offset].  */
+  gfc_symbol *var = code->ext.iterator->var->symtree->n.sym;
+
+  tree tree_var = NULL_TREE;
+  tree a1 = integer_one_node;
+  tree a2 = integer_zero_node;
+
+  if (!simple)
+    {
+      /* FIXME: Handle non-unit iter steps, cf. PR fortran/107424.  */
+      sorry_at (gfc_get_location (&curr_loop_var->where),
+		"non-rectangular loop nest with step other than constant 1 "
+		"or -1 for %qs", curr_loop_var->symtree->n.sym->name);
+      return false;
+    }
+
+  dovar_init *di;
+  unsigned ix;
+  FOR_EACH_VEC_ELT (*inits, ix, di)
+    if (di->sym == var)
+      {
+	if (!di->non_unit_iter)
+	  {
+	    tree_var = di->init;
+	    gcc_assert (DECL_P (tree_var));
+	    break;
+	  }
+	else
+	  {
+	    /* FIXME: Handle non-unit iter steps, cf. PR fortran/107424.  */
+	    sorry_at (gfc_get_location (&code->loc),
+		      "non-rectangular loop nest with step other than constant "
+		      "1 or -1 for %qs", var->name);
+	    inform (gfc_get_location (&expr->where), "Used here");
+	    return false;
+	  }
+      }
+  if (tree_var == NULL_TREE)
+    tree_var = var->backend_decl;
+
+  if (expr->expr_type == EXPR_VARIABLE)
+    gcc_assert (expr->symtree->n.sym == var);
+  else if (expr->expr_type != EXPR_OP
+	   || (expr->value.op.op != INTRINSIC_TIMES
+	       && expr->value.op.op != INTRINSIC_PLUS
+	       && expr->value.op.op != INTRINSIC_MINUS))
+    gcc_unreachable ();
+  else
+    {
+      gfc_se se;
+      gfc_expr *et = NULL, *eo = NULL, *e = expr;
+      if (expr->value.op.op != INTRINSIC_TIMES)
+	{
+	  if (gfc_find_sym_in_expr (var, expr->value.op.op1))
+	    {
+	      e = expr->value.op.op1;
+	      eo = expr->value.op.op2;
+	    }
+	  else
+	    {
+	      eo = expr->value.op.op1;
+	      e = expr->value.op.op2;
+	    }
+	}
+      if (e->value.op.op == INTRINSIC_TIMES)
+	{
+	  if (e->value.op.op1->expr_type == EXPR_VARIABLE
+	      && e->value.op.op1->symtree->n.sym == var)
+	    et = e->value.op.op2;
+	  else
+	    {
+	      et = e->value.op.op1;
+	      gcc_assert (e->value.op.op2->expr_type == EXPR_VARIABLE
+			  && e->value.op.op2->symtree->n.sym == var);
+	    }
+	}
+      else
+	gcc_assert (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym == var);
+      if (et != NULL)
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr_val (&se, et);
+	  gfc_add_block_to_block (pblock, &se.pre);
+	  a1 = se.expr;
+	}
+      if (eo != NULL)
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr_val (&se, eo);
+	  gfc_add_block_to_block (pblock, &se.pre);
+	  a2 = se.expr;
+	  if (expr->value.op.op == INTRINSIC_MINUS && expr->value.op.op2 == eo)
+	    /* outer-var - a2.  */
+	    a2 = fold_build1 (NEGATE_EXPR, TREE_TYPE (a2), a2);
+	  else if (expr->value.op.op == INTRINSIC_MINUS)
+	    /* a2 - outer-var.  */
+	    a1 = fold_build1 (NEGATE_EXPR, TREE_TYPE (a1), a1);
+	}
+      a1 = DECL_P (a1) ? a1 : gfc_evaluate_now (a1, pblock);
+      a2 = DECL_P (a2) ? a2 : gfc_evaluate_now (a2, pblock);
+    }
+
+  gfc_init_se (sep, NULL);
+  sep->expr = make_tree_vec (3);
+  TREE_VEC_ELT (sep->expr, 0) = tree_var;
+  TREE_VEC_ELT (sep->expr, 1) = fold_convert (TREE_TYPE (tree_var), a1);
+  TREE_VEC_ELT (sep->expr, 2) = fold_convert (TREE_TYPE (tree_var), a2);
+
+  return true;
+}
 
 static tree
 gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
@@ -5127,7 +5255,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
 {
   gfc_se se;
   tree dovar, stmt, from, to, step, type, init, cond, incr, orig_decls;
-  tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
+  tree local_dovar = NULL_TREE, cycle_label, tmp, omp_clauses;
   stmtblock_t block;
   stmtblock_t body;
   gfc_omp_clauses *clauses = code->ext.omp_clauses;
@@ -5214,52 +5342,72 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
       gfc_init_se (&se, NULL);
       gfc_conv_expr_lhs (&se, code->ext.iterator->var);
       gfc_add_block_to_block (pblock, &se.pre);
-      dovar = se.expr;
+      local_dovar = dovar_decl = dovar = se.expr;
       type = TREE_TYPE (dovar);
       gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
 
       gfc_init_se (&se, NULL);
-      gfc_conv_expr_val (&se, code->ext.iterator->start);
+      gfc_conv_expr_val (&se, code->ext.iterator->step);
       gfc_add_block_to_block (pblock, &se.pre);
-      from = gfc_evaluate_now (se.expr, pblock);
+      step = gfc_evaluate_now (se.expr, pblock);
 
-      gfc_init_se (&se, NULL);
-      gfc_conv_expr_val (&se, code->ext.iterator->end);
-      gfc_add_block_to_block (pblock, &se.pre);
-      to = gfc_evaluate_now (se.expr, pblock);
+      if (integer_onep (step))
+	simple = 1;
+      else if (tree_int_cst_equal (step, integer_minus_one_node))
+	simple = -1;
 
       gfc_init_se (&se, NULL);
-      gfc_conv_expr_val (&se, code->ext.iterator->step);
-      gfc_add_block_to_block (pblock, &se.pre);
-      step = gfc_evaluate_now (se.expr, pblock);
-      dovar_decl = dovar;
+      if (!clauses->non_rectangular
+	  || !gfc_nonrect_loop_expr (pblock, &se, i, orig_code->block->next,
+				     code->ext.iterator->start, &inits, simple,
+				     code->ext.iterator->var))
+	{
+	  gfc_conv_expr_val (&se, code->ext.iterator->start);
+	  gfc_add_block_to_block (pblock, &se.pre);
+	  if (!DECL_P (se.expr))
+	    se.expr = gfc_evaluate_now (se.expr, pblock);
+	}
+      from = se.expr;
 
-      /* Special case simple loops.  */
-      if (VAR_P (dovar))
+      gfc_init_se (&se, NULL);
+      if (!clauses->non_rectangular
+	  || !gfc_nonrect_loop_expr (pblock, &se, i, orig_code->block->next,
+				     code->ext.iterator->end, &inits, simple,
+				     code->ext.iterator->var))
 	{
-	  if (integer_onep (step))
-	    simple = 1;
-	  else if (tree_int_cst_equal (step, integer_minus_one_node))
-	    simple = -1;
+	  gfc_conv_expr_val (&se, code->ext.iterator->end);
+	  gfc_add_block_to_block (pblock, &se.pre);
+	  if (!DECL_P (se.expr))
+	    se.expr = gfc_evaluate_now (se.expr, pblock);
 	}
-      else
+      to = se.expr;
+
+      if (!DECL_P (dovar))
 	dovar_decl
 	  = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym,
 				    false);
-
+      if (simple && !DECL_P (dovar))
+	{
+	  const char *name = code->ext.iterator->var->symtree->n.sym->name;
+	  local_dovar = gfc_create_var (type, name);
+	  dovar_init e = {code->ext.iterator->var->symtree->n.sym,
+			  dovar, local_dovar, false};
+	  inits.safe_push (e);
+	}
       /* Loop body.  */
       if (simple)
 	{
-	  TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from);
+	  TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, local_dovar, from);
 	  /* The condition should not be folded.  */
 	  TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0
 					       ? LE_EXPR : GE_EXPR,
-					       logical_type_node, dovar, to);
+					       logical_type_node, local_dovar,
+					       to);
 	  TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
-						    type, dovar, step);
+						    type, local_dovar, step);
 	  TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
 						    MODIFY_EXPR,
-						    type, dovar,
+						    type, local_dovar,
 						    TREE_VEC_ELT (incr, i));
 	  if (orig_decls && !clauses->orderedc)
 	    orig_decls = NULL;
@@ -5280,24 +5428,27 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
 	  tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, type, tmp,
 				 step);
 	  tmp = gfc_evaluate_now (tmp, pblock);
-	  count = gfc_create_var (type, "count");
-	  TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count,
+	  local_dovar = gfc_create_var (type, "count");
+	  TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, local_dovar,
 					     build_int_cst (type, 0));
 	  /* The condition should not be folded.  */
 	  TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR,
 					       logical_type_node,
-					       count, tmp);
+					       local_dovar, tmp);
 	  TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
-						    type, count,
+						    type, local_dovar,
 						    build_int_cst (type, 1));
 	  TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
-						    MODIFY_EXPR, type, count,
+						    MODIFY_EXPR, type,
+						    local_dovar,
 						    TREE_VEC_ELT (incr, i));
 
 	  /* Initialize DOVAR.  */
-	  tmp = fold_build2_loc (input_location, MULT_EXPR, type, count, step);
+	  tmp = fold_build2_loc (input_location, MULT_EXPR, type, local_dovar,
+				 step);
 	  tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp);
-	  dovar_init e = {dovar, tmp};
+	  dovar_init e = {code->ext.iterator->var->symtree->n.sym,
+			  dovar, tmp, true};
 	  inits.safe_push (e);
 	  if (clauses->orderedc)
 	    {
@@ -5312,7 +5463,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
       if (dovar_found == 3
 	  && op == EXEC_OMP_SIMD
 	  && collapse == 1
-	  && !simple)
+	  && local_dovar != dovar)
 	{
 	  for (tmp = omp_clauses; tmp; tmp = OMP_CLAUSE_CHAIN (tmp))
 	    if (OMP_CLAUSE_CODE (tmp) == OMP_CLAUSE_LINEAR
@@ -5331,11 +5482,11 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
 	      OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
 	      OMP_CLAUSE_DECL (tmp) = dovar_decl;
 	      omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
+	      if (local_dovar != dovar)
+		dovar_found = 3;
 	    }
-	  if (!simple)
-	    dovar_found = 3;
 	}
-      else if (!dovar_found && !simple)
+      else if (!dovar_found && local_dovar != dovar)
 	{
 	  tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
 	  OMP_CLAUSE_DECL (tmp) = dovar_decl;
@@ -5346,7 +5497,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
 	  tree c = NULL;
 
 	  tmp = NULL;
-	  if (!simple)
+	  if (local_dovar != dovar)
 	    {
 	      /* If dovar is lastprivate, but different counter is used,
 		 dovar += step needs to be added to
@@ -5356,21 +5507,19 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
 	      if (clauses->orderedc)
 		{
 		  if (clauses->collapse <= 1 || i >= clauses->collapse)
-		    tmp = count;
+		    tmp = local_dovar;
 		  else
 		    tmp = fold_build2_loc (input_location, PLUS_EXPR,
-					   type, count, build_one_cst (type));
+					   type, local_dovar,
+					   build_one_cst (type));
 		  tmp = fold_build2_loc (input_location, MULT_EXPR, type,
 					 tmp, step);
 		  tmp = fold_build2_loc (input_location, PLUS_EXPR, type,
 					 from, tmp);
 		}
 	      else
-		{
-		  tmp = gfc_evaluate_now (step, pblock);
-		  tmp = fold_build2_loc (input_location, PLUS_EXPR, type,
-					 dovar, tmp);
-		}
+		tmp = fold_build2_loc (input_location, PLUS_EXPR, type,
+				       dovar, step);
 	      tmp = fold_build2_loc (input_location, MODIFY_EXPR, type,
 				     dovar, tmp);
 	      for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
@@ -5405,9 +5554,9 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
 		    break;
 		  }
 	    }
-	  gcc_assert (simple || c != NULL);
+	  gcc_assert (local_dovar == dovar || c != NULL);
 	}
-      if (!simple)
+      if (local_dovar != dovar)
 	{
 	  if (op != EXEC_OMP_SIMD || dovar_found == 1)
 	    tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
@@ -5420,7 +5569,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
 	    }
 	  else
 	    tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE);
-	  OMP_CLAUSE_DECL (tmp) = count;
+	  OMP_CLAUSE_DECL (tmp) = local_dovar;
 	  omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
 	}