re PR fortran/69741 (Bad error in forall with array loop counters)

2016-11-20  Harald Anlauf  <anlauf@gmx.de>

	PR fortran/69741
	* resolve.c (gfc_resolve_forall): Check for nonscalar index variables.

2016-11-20  Harald Anlauf  <anlauf@gmx.de>

	PR fortran/69741
	* gfortran.dg/forall_18.f90: New testcase.

From-SVN: r242641

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c06bb162c077c726f0129e319db4df0bc1e881ba..109aca33261198a5b799597c8d69fe8e35200ea2 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2016-11-20  Harald Anlauf  <anlauf@gmx.de>
+
+       PR fortran/69741
+       * resolve.c (gfc_resolve_forall): Check for nonscalar index variables.
+
 2016-11-20  Andre Vehreschild  <vehre@gcc.gnu.org>
 
        PR fortran/78395

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 589a673e52ecd134acf4891a48d7cf4c79e42365..9e628f18a11a2a545e94d9b7f47cdc93daa00a76 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9647,16 +9647,15 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
   static gfc_expr **var_expr;
   static int total_var = 0;
   static int nvar = 0;
-  int old_nvar, tmp;
+  int i, old_nvar, tmp;
   gfc_forall_iterator *fa;
-  int i;
 
   old_nvar = nvar;
 
   /* Start to resolve a FORALL construct   */
   if (forall_save == 0)
     {
-      /* Count the total number of FORALL index in the nested FORALL
+      /* Count the total number of FORALL indices in the nested FORALL
          construct in order to allocate the VAR_EXPR with proper size.  */
       total_var = gfc_count_forall_iterators (code);
 
@@ -9664,19 +9663,25 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
       var_expr = XCNEWVEC (gfc_expr *, total_var);
     }
 
-  /* The information about FORALL iterator, including FORALL index start, end
-     and stride. The FORALL index can not appear in start, end or stride.  */
+  /* The information about FORALL iterator, including FORALL indices start, end
+     and stride.  An outer FORALL indice cannot appear in start, end or stride.  */
   for (fa = code->ext.forall_iterator; fa; fa = fa->next)
     {
+      /* Fortran 20008: C738 (R753).  */
+      if (fa->var->ref && fa->var->ref->type == REF_ARRAY)
+       {
+         gfc_error ("FORALL index-name at %L must be a scalar variable "
+                    "of type integer", &fa->var->where);
+         continue;
+       }
+
       /* Check if any outer FORALL index name is the same as the current
         one.  */
       for (i = 0; i < nvar; i++)
        {
          if (fa->var->symtree->n.sym == var_expr[i]->symtree->n.sym)
-           {
-             gfc_error ("An outer FORALL construct already has an index "
-                        "with this name %L", &fa->var->where);
-           }
+           gfc_error ("An outer FORALL construct already has an index "
+                       "with this name %L", &fa->var->where);
        }
 
       /* Record the current FORALL index.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2c81bf439ad5f7299d19c84a3a0105be3d2dee6c..6a23d9069195d4909005c024546ffd21cac3c447 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-11-20  Harald Anlauf  <anlauf@gmx.de>
+ 
+       PR fortran/69741
+       * gfortran.dg/forall_18.f90: New testcase.
+
 2016-11-20  Marc Glisse  <marc.glisse@inria.fr>
 
        * gcc.dg/tree-ssa/cmpexactdiv.c: New file.

diff --git a/gcc/testsuite/gfortran.dg/forall_18.f90 b/gcc/testsuite/gfortran.dg/forall_18.f90
new file mode 100644 (file)
index 0000000..3cfe547
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/forall_18.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! PR fortran/69741 - improve error message for nonscalar FORALL index variables
+!
+subroutine check
+  integer :: ii(2), i
+  real :: a(3,2)
+
+  forall (ii(1)=1:3, i=1:2) ! { dg-error "scalar variable of type integer" }
+     a(ii(1),i) = ii(1) * i
+  end forall
+
+  forall (j=1:3, ii(2)=1:2) ! { dg-error "scalar variable of type integer" }
+     a(j,ii(2)) = j * ii(2)
+  end forall
+
+end subroutine check