From 1c54741a0e03064fee403083b2d18336b75ec24b Mon Sep 17 00:00:00 2001
From: "Steven G. Kargl" <kargls@comcast.net>
Date: Tue, 3 Jan 2006 22:01:10 +0000
Subject: [PATCH] re PR fortran/25101 ([4.1] Zero stride allowed in FORALL:s)

2006-01-03  Steven G. Kargl  <kargls@comcast.net>

	PR fortran/25101
	* resolve.c (resolve_forall_iterators):  Check for scalar variables;
	Check stride is nonzero.

	* gfortran.dg/forall_2.f90:  New test.

From-SVN: r109288
---
 gcc/fortran/ChangeLog                  |  6 +++++
 gcc/fortran/resolve.c                  | 31 +++++++++++++++++---------
 gcc/testsuite/ChangeLog                |  5 +++++
 gcc/testsuite/gfortran.dg/forall_2.f90 |  9 ++++++++
 4 files changed, 40 insertions(+), 11 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/forall_2.f90

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e2f63f6131a3..a1aec2588dff 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2006-01-03  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/25101
+	* resolve.c (resolve_forall_iterators):  Check for scalar variables;
+	Check stride is nonzero.
+
 2006-01-02  Steven G. Kargl  <kargls@comcast.net>
 
 	PR fortran/24640
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 63c9abde22c8..d0b7ab97acaf 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2509,7 +2509,9 @@ gfc_resolve_iterator (gfc_iterator * iter, bool real_ok)
 }
 
 
-/* Resolve a list of FORALL iterators.  */
+/* 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.  */
 
 static void
 resolve_forall_iterators (gfc_forall_iterator * iter)
@@ -2518,28 +2520,35 @@ resolve_forall_iterators (gfc_forall_iterator * iter)
   while (iter)
     {
       if (gfc_resolve_expr (iter->var) == SUCCESS
-	  && iter->var->ts.type != BT_INTEGER)
-	gfc_error ("FORALL Iteration variable at %L must be INTEGER",
+	  && (iter->var->ts.type != BT_INTEGER || iter->var->rank != 0))
+	gfc_error ("FORALL index-name at %L must be a scalar INTEGER",
 		   &iter->var->where);
 
       if (gfc_resolve_expr (iter->start) == SUCCESS
-	  && iter->start->ts.type != BT_INTEGER)
-	gfc_error ("FORALL start expression at %L must be INTEGER",
+	  && (iter->start->ts.type != BT_INTEGER || iter->start->rank != 0))
+	gfc_error ("FORALL start expression at %L must be a scalar INTEGER",
 		   &iter->start->where);
       if (iter->var->ts.kind != iter->start->ts.kind)
 	gfc_convert_type (iter->start, &iter->var->ts, 2);
 
       if (gfc_resolve_expr (iter->end) == SUCCESS
-	  && iter->end->ts.type != BT_INTEGER)
-	gfc_error ("FORALL end expression at %L must be INTEGER",
+	  && (iter->end->ts.type != BT_INTEGER || iter->end->rank != 0))
+	gfc_error ("FORALL end expression at %L must be a scalar INTEGER",
 		   &iter->end->where);
       if (iter->var->ts.kind != iter->end->ts.kind)
 	gfc_convert_type (iter->end, &iter->var->ts, 2);
 
-      if (gfc_resolve_expr (iter->stride) == SUCCESS
-	  && iter->stride->ts.type != BT_INTEGER)
-	gfc_error ("FORALL Stride expression at %L must be INTEGER",
-		   &iter->stride->where);
+      if (gfc_resolve_expr (iter->stride) == SUCCESS)
+	{
+	  if (iter->stride->ts.type != BT_INTEGER || iter->stride->rank != 0)
+	    gfc_error ("FORALL stride expression at %L must be a scalar %s",
+		        &iter->stride->where, "INTEGER");
+
+	  if (iter->stride->expr_type == EXPR_CONSTANT
+	      && mpz_cmp_ui(iter->stride->value.integer, 0) == 0)
+	    gfc_error ("FORALL stride expression at %L cannot be zero",
+		       &iter->stride->where);
+	}
       if (iter->var->ts.kind != iter->stride->ts.kind)
 	gfc_convert_type (iter->stride, &iter->var->ts, 2);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2fbd33a62090..9d4355caa65c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-01-03  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/25101
+	* gfortran.dg/forall_2.f90:  New test.
+
 2006-01-03  Hans-Peter Nilsson  <hp@bitrange.com>
 
 	* g++.dg/abi/thunk3.C, g++.dg/abi/thunk4.C: Gate on
diff --git a/gcc/testsuite/gfortran.dg/forall_2.f90 b/gcc/testsuite/gfortran.dg/forall_2.f90
new file mode 100644
index 000000000000..223c2cea79e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_2.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+! PR fortran/25101  -- Stride must be nonzero.
+program forall_2
+   integer :: a(10),j(2),i
+   forall(i=1:2:0)  ! { dg-error "stride expression at" }
+     a(i)=1
+   end forall
+end program forall_2
+
-- 
GitLab