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

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

[Tobias Schlüter]

[-- Attachment #1: Type: text/plain, Size: 634 bytes --]


Hi,

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.

Built and tested on i386-darwin.

Cheers,
- Tobi

[-- Attachment #2: pr25097.diff.txt --]
[-- Type: text/plain, Size: 9436 bytes --]

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

	PR fortran/25097
fortran/
	* resolve.c (gfc_find_forall_index): Move towards top.
	(resolve_forall_iterators): Verify additional constraint.
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 21:43:54 2007 +0200
@@ -4295,14 +4295,144 @@ 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
+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 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 +4466,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->next; iter2; iter2 = iter2->next)
+      {
+	if (gfc_find_forall_index (iter2->start,
+				   iter->var->symtree->n.sym) == SUCCESS
+	    || gfc_find_forall_index (iter2->end,
+				      iter->var->symtree->n.sym) == SUCCESS
+	    || gfc_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 +5670,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.  */
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 21:43:54 2007 +0200
@@ -0,0 +1,23 @@
+! { 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=1:10)
+   forall (j=i:10)
+      a(i,j) = i*j
+   end forall
+end forall
+END

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

[Tobias Schlüter]

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.

- Tobi

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

[Tobias Schlüter]

[-- Attachment #1: Type: text/plain, Size: 1372 bytes --]

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

[-- Attachment #2: pr25097.diff.txt --]
[-- Type: text/plain, Size: 11563 bytes --]

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

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

[Tobias Schlüter]

Sigh, the corrct PR number is PR 25076.

- Tobi

Tobias Schlüter wrote:
> 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
> 

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

[Paul Thomas]

Tobi,
>
>
> Built and testing on i386-darwin.  Ok, provided the testsuite passes?
>
OK - many thanks.

Paul

PS We have a number of functions that sweep through an expression and 
doing something by comparison with a symbol.  I have been meaning for a 
long time to put together a master function to do this - I'll likely do 
it when I finally get around to PR29389.