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]

Re: [gfortran, fix PR 25097] Additional constraints on FORALL headers


Tobias Schlüter wrote:
Tobias Schlüter wrote:
we hadn't yet implemented the following constraint on FORALL headers:
"A subscript or stride in a forall-triplet-spec shall not contain a reference to any index-name in the forall-triplet-spec-list in which it appears." This patch fixes this, using the pre-existing gfc_find_forall_index for the purpose. This meant moving it to the front of the file, and calling it in a trivial fashion (which is wasteful, but I can't imagine this ever becoming a performance bottleneck). I promise to remove the "gfc_" prefix, I only realized its presence after I had cut the diff.

Please don't waste your time on this patch yet: while removing the gfc_* prefix, I found that there already exists code which claims to address the same issue. I'll see what it does, and why it doesn't do as advertized and report back.

Ok, here's an updated version. It removes the old code and augments my new code to also check all triplet specifications, not only later ones (i.e. for (iter; ... ) for (iter = iter; ...) instead of for (iter; ... ) for (iter = iter->next; ...)). Throwing this at the testsuite revealed the necessity to deal with NULL expressions in find_forall_index(), which was done.


Built and testing on i386-darwin. Ok, provided the testsuite passes?

Cheers,
- Tobi
2007-10-04  Tobias Schlüter  <tobi@gcc.gnu.org>

	PR fortran/25097
fortran/
	* resolve.c (gfc_find_forall_index): Move towards top,
	renaming to ...
	(find_forall_index): ... this.  Add check for NULL expr.
	(resolve_forall_iterators): Verify additional constraint.
	(resolve_forall): Remove checks obsoleted by new code in
	resolve_forall_iterators.
testsuite/
	* gfortran.dg/forall_11.f90: New.

diff -r 837a74b49f29 gcc/fortran/resolve.c
--- a/gcc/fortran/resolve.c	Thu Oct 04 15:59:54 2007 +0000
+++ b/gcc/fortran/resolve.c	Thu Oct 04 22:29:04 2007 +0200
@@ -4295,14 +4295,147 @@ gfc_resolve_iterator (gfc_iterator *iter
 }
 
 
+/* Check whether the FORALL index appears in the expression or not.
+   Returns SUCCESS if SYM is found in EXPR.  */
+
+static try
+find_forall_index (gfc_expr *expr, gfc_symbol *symbol)
+{
+  gfc_array_ref ar;
+  gfc_ref *tmp;
+  gfc_actual_arglist *args;
+  int i;
+
+  if (!expr)
+    return FAILURE;
+
+  switch (expr->expr_type)
+    {
+    case EXPR_VARIABLE:
+      gcc_assert (expr->symtree->n.sym);
+
+      /* A scalar assignment  */
+      if (!expr->ref)
+	{
+	  if (expr->symtree->n.sym == symbol)
+	    return SUCCESS;
+	  else
+	    return FAILURE;
+	}
+
+      /* the expr is array ref, substring or struct component.  */
+      tmp = expr->ref;
+      while (tmp != NULL)
+	{
+	  switch (tmp->type)
+	    {
+	    case  REF_ARRAY:
+	      /* Check if the symbol appears in the array subscript.  */
+	      ar = tmp->u.ar;
+	      for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
+		{
+		  if (ar.start[i])
+		    if (find_forall_index (ar.start[i], symbol) == SUCCESS)
+		      return SUCCESS;
+
+		  if (ar.end[i])
+		    if (find_forall_index (ar.end[i], symbol) == SUCCESS)
+		      return SUCCESS;
+
+		  if (ar.stride[i])
+		    if (find_forall_index (ar.stride[i], symbol) == SUCCESS)
+		      return SUCCESS;
+		}  /* end for  */
+	      break;
+
+	    case REF_SUBSTRING:
+	      if (expr->symtree->n.sym == symbol)
+		return SUCCESS;
+	      tmp = expr->ref;
+	      /* Check if the symbol appears in the substring section.  */
+	      if (find_forall_index (tmp->u.ss.start, symbol) == SUCCESS)
+		return SUCCESS;
+	      if (find_forall_index (tmp->u.ss.end, symbol) == SUCCESS)
+		return SUCCESS;
+	      break;
+
+	    case REF_COMPONENT:
+	      break;
+
+	    default:
+	      gfc_error("expression reference type error at %L", &expr->where);
+	    }
+	  tmp = tmp->next;
+	}
+      break;
+
+    /* If the expression is a function call, then check if the symbol
+       appears in the actual arglist of the function.  */
+    case EXPR_FUNCTION:
+      for (args = expr->value.function.actual; args; args = args->next)
+	{
+	  if (find_forall_index(args->expr,symbol) == SUCCESS)
+	    return SUCCESS;
+	}
+      break;
+
+    /* It seems not to happen.  */
+    case EXPR_SUBSTRING:
+      if (expr->ref)
+	{
+	  tmp = expr->ref;
+	  gcc_assert (expr->ref->type == REF_SUBSTRING);
+	  if (find_forall_index (tmp->u.ss.start, symbol) == SUCCESS)
+	    return SUCCESS;
+	  if (find_forall_index (tmp->u.ss.end, symbol) == SUCCESS)
+	    return SUCCESS;
+	}
+      break;
+
+    /* It seems not to happen.  */
+    case EXPR_STRUCTURE:
+    case EXPR_ARRAY:
+      gfc_error ("Unsupported statement while finding forall index in "
+		 "expression");
+      break;
+
+    case EXPR_OP:
+      /* Find the FORALL index in the first operand.  */
+      if (expr->value.op.op1)
+	{
+	  if (find_forall_index (expr->value.op.op1, symbol) == SUCCESS)
+	    return SUCCESS;
+	}
+
+      /* Find the FORALL index in the second operand.  */
+      if (expr->value.op.op2)
+	{
+	  if (find_forall_index (expr->value.op.op2, symbol) == SUCCESS)
+	    return SUCCESS;
+	}
+      break;
+
+    default:
+      break;
+    }
+
+  return FAILURE;
+}
+
+
 /* Resolve a list of FORALL iterators.  The FORALL index-name is constrained
    to be a scalar INTEGER variable.  The subscripts and stride are scalar
-   INTEGERs, and if stride is a constant it must be nonzero.  */
+   INTEGERs, and if stride is a constant it must be nonzero.
+   Furthermore "A subscript or stride in a forall-triplet-spec shall
+   not contain a reference to any index-name in the
+   forall-triplet-spec-list in which it appears." (7.5.4.1)  */
 
 static void
-resolve_forall_iterators (gfc_forall_iterator *iter)
-{
-  while (iter)
+resolve_forall_iterators (gfc_forall_iterator *it)
+{
+  gfc_forall_iterator *iter, *iter2;
+
+  for (iter = it; iter; iter = iter->next)
     {
       if (gfc_resolve_expr (iter->var) == SUCCESS
 	  && (iter->var->ts.type != BT_INTEGER || iter->var->rank != 0))
@@ -4336,9 +4469,21 @@ resolve_forall_iterators (gfc_forall_ite
 	}
       if (iter->var->ts.kind != iter->stride->ts.kind)
 	gfc_convert_type (iter->stride, &iter->var->ts, 2);
-
-      iter = iter->next;
-    }
+    }
+
+  for (iter = it; iter; iter = iter->next)
+    for (iter2 = iter; iter2; iter2 = iter2->next)
+      {
+	if (find_forall_index (iter2->start,
+			       iter->var->symtree->n.sym) == SUCCESS
+	    || find_forall_index (iter2->end,
+				  iter->var->symtree->n.sym) == SUCCESS
+	    || find_forall_index (iter2->stride,
+				  iter->var->symtree->n.sym) == SUCCESS)
+	  gfc_error ("FORALL index '%s' may not appear in triplet "
+		     "specification at %L", iter->var->symtree->name,
+		     &iter->start->where);
+      }
 }
 
 
@@ -5528,130 +5673,6 @@ resolve_where (gfc_code *code, gfc_expr 
 }
 
 
-/* Check whether the FORALL index appears in the expression or not.  */
-
-static try
-gfc_find_forall_index (gfc_expr *expr, gfc_symbol *symbol)
-{
-  gfc_array_ref ar;
-  gfc_ref *tmp;
-  gfc_actual_arglist *args;
-  int i;
-
-  switch (expr->expr_type)
-    {
-    case EXPR_VARIABLE:
-      gcc_assert (expr->symtree->n.sym);
-
-      /* A scalar assignment  */
-      if (!expr->ref)
-	{
-	  if (expr->symtree->n.sym == symbol)
-	    return SUCCESS;
-	  else
-	    return FAILURE;
-	}
-
-      /* the expr is array ref, substring or struct component.  */
-      tmp = expr->ref;
-      while (tmp != NULL)
-	{
-	  switch (tmp->type)
-	    {
-	    case  REF_ARRAY:
-	      /* Check if the symbol appears in the array subscript.  */
-	      ar = tmp->u.ar;
-	      for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
-		{
-		  if (ar.start[i])
-		    if (gfc_find_forall_index (ar.start[i], symbol) == SUCCESS)
-		      return SUCCESS;
-
-		  if (ar.end[i])
-		    if (gfc_find_forall_index (ar.end[i], symbol) == SUCCESS)
-		      return SUCCESS;
-
-		  if (ar.stride[i])
-		    if (gfc_find_forall_index (ar.stride[i], symbol) == SUCCESS)
-		      return SUCCESS;
-		}  /* end for  */
-	      break;
-
-	    case REF_SUBSTRING:
-	      if (expr->symtree->n.sym == symbol)
-		return SUCCESS;
-	      tmp = expr->ref;
-	      /* Check if the symbol appears in the substring section.  */
-	      if (gfc_find_forall_index (tmp->u.ss.start, symbol) == SUCCESS)
-		return SUCCESS;
-	      if (gfc_find_forall_index (tmp->u.ss.end, symbol) == SUCCESS)
-		return SUCCESS;
-	      break;
-
-	    case REF_COMPONENT:
-	      break;
-
-	    default:
-	      gfc_error("expression reference type error at %L", &expr->where);
-	    }
-	  tmp = tmp->next;
-	}
-      break;
-
-    /* If the expression is a function call, then check if the symbol
-       appears in the actual arglist of the function.  */
-    case EXPR_FUNCTION:
-      for (args = expr->value.function.actual; args; args = args->next)
-	{
-	  if (gfc_find_forall_index(args->expr,symbol) == SUCCESS)
-	    return SUCCESS;
-	}
-      break;
-
-    /* It seems not to happen.  */
-    case EXPR_SUBSTRING:
-      if (expr->ref)
-	{
-	  tmp = expr->ref;
-	  gcc_assert (expr->ref->type == REF_SUBSTRING);
-	  if (gfc_find_forall_index (tmp->u.ss.start, symbol) == SUCCESS)
-	    return SUCCESS;
-	  if (gfc_find_forall_index (tmp->u.ss.end, symbol) == SUCCESS)
-	    return SUCCESS;
-	}
-      break;
-
-    /* It seems not to happen.  */
-    case EXPR_STRUCTURE:
-    case EXPR_ARRAY:
-      gfc_error ("Unsupported statement while finding forall index in "
-		 "expression");
-      break;
-
-    case EXPR_OP:
-      /* Find the FORALL index in the first operand.  */
-      if (expr->value.op.op1)
-	{
-	  if (gfc_find_forall_index (expr->value.op.op1, symbol) == SUCCESS)
-	    return SUCCESS;
-	}
-
-      /* Find the FORALL index in the second operand.  */
-      if (expr->value.op.op2)
-	{
-	  if (gfc_find_forall_index (expr->value.op.op2, symbol) == SUCCESS)
-	    return SUCCESS;
-	}
-      break;
-
-    default:
-      break;
-    }
-
-  return FAILURE;
-}
-
-
 /* Resolve assignment in FORALL construct.
    NVAR is the number of FORALL index variables, and VAR_EXPR records the
    FORALL index variables.  */
@@ -5678,7 +5699,7 @@ gfc_resolve_assign_in_forall (gfc_code *
 	  /* If one of the FORALL index variables doesn't appear in the
 	     assignment target, then there will be a many-to-one
 	     assignment.  */
-	  if (gfc_find_forall_index (code->expr, forall_index) == FAILURE)
+	  if (find_forall_index (code->expr, forall_index) == FAILURE)
 	    gfc_error ("The FORALL with index '%s' cause more than one "
 		       "assignment to this object at %L",
 		       var_expr[n]->symtree->name, &code->expr->where);
@@ -5784,7 +5805,6 @@ gfc_resolve_forall (gfc_code *code, gfc_
   static int total_var = 0;
   static int nvar = 0;
   gfc_forall_iterator *fa;
-  gfc_symbol *forall_index;
   gfc_code *next;
   int i;
 
@@ -5823,18 +5843,6 @@ gfc_resolve_forall (gfc_code *code, gfc_
       /* Record the current FORALL index.  */
       var_expr[nvar] = gfc_copy_expr (fa->var);
 
-      forall_index = fa->var->symtree->n.sym;
-
-      /* Check if the FORALL index appears in start, end or stride.  */
-      if (gfc_find_forall_index (fa->start, forall_index) == SUCCESS)
-	gfc_error ("A FORALL index must not appear in a limit or stride "
-		   "expression in the same FORALL at %L", &fa->start->where);
-      if (gfc_find_forall_index (fa->end, forall_index) == SUCCESS)
-	gfc_error ("A FORALL index must not appear in a limit or stride "
-		   "expression in the same FORALL at %L", &fa->end->where);
-      if (gfc_find_forall_index (fa->stride, forall_index) == SUCCESS)
-	gfc_error ("A FORALL index must not appear in a limit or stride "
-		   "expression in the same FORALL at %L", &fa->stride->where);
       nvar++;
     }
 
diff -r 837a74b49f29 gcc/testsuite/gfortran.dg/forall_11.f90
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/gfortran.dg/forall_11.f90	Thu Oct 04 22:29:04 2007 +0200
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! PR 25076
+! We erroneously accepted it when a FORALL index was used in a triplet
+! specification within the same FORALL header
+INTEGER :: A(10,10)
+FORALL(I=1:10,J=I:10) ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+  A(I,J)=I+J
+ENDFORALL
+
+forall (i=1:10, j=1:i)  ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+   a(i,j) = 5
+end forall
+
+forall (i=1:10, j=1:10:i)  ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+   a(i,j) = i - j
+end forall
+
+forall (i=i:10) ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+   forall (j=1:j:i)  !  { dg-error "FORALL index 'j' may not appear in triplet specification" }
+      a(i,j) = i*j
+   end forall
+end forall
+
+forall (i=1:10:i) ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+   a(1,i) = 2
+end forall
+
+forall (i=1:10)
+   forall (j=i:10)
+      a(i,j) = i*j
+   end forall
+end forall
+END

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