diff mbox

[fortran] Fix PR 80988

Message ID bd389ec8-34c4-6a1a-f9d7-90fa7e270104@netcologne.de
State New
Headers show

Commit Message

Thomas Koenig June 9, 2017, 8:47 p.m. UTC
Hello world,

the attached patch fixes the PR by not doing a replacement of
(a(i,i),i=1,3) by an array expression (which does not exist).

Regression-tested.  OK for trunk?

Regards

	Thomas

2017-06-09  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/80988
         * frontend-passes.c (traverse_io_block):  Also
         check for variables occurring as indices multiple
         time in a single implied DO loop.

2017-06-09  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/80988
         * gfortran.dg/implied_do_io_3.f90:  New test.

Comments

Jerry DeLisle June 9, 2017, 11:45 p.m. UTC | #1
On 06/09/2017 01:47 PM, Thomas Koenig wrote:
> Hello world,
> 
> the attached patch fixes the PR by not doing a replacement of
> (a(i,i),i=1,3) by an array expression (which does not exist).
> 
> Regression-tested.  OK for trunk?
>

OK, thanks

> Regards
> 
>      Thomas
> 
> 2017-06-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
> 
>          PR fortran/80988
>          * frontend-passes.c (traverse_io_block):  Also
>          check for variables occurring as indices multiple
>          time in a single implied DO loop.
> 
> 2017-06-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
> 
>          PR fortran/80988
>          * gfortran.dg/implied_do_io_3.f90:  New test.
diff mbox

Patch

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 249039)
+++ frontend-passes.c	(Arbeitskopie)
@@ -1164,7 +1164,14 @@  traverse_io_block (gfc_code *code, bool *has_reach
 	  /*  Check for (a(k), i=1,4) or ((a(j, i), i=1,4), j=1,4).  */
 	  if (!stack_top || !stack_top->iter
 	      || stack_top->iter->var->symtree != start->symtree)
-	    iters[i] = NULL;
+	    {
+	      /* Check for (a(i,i), i=1,3).  */
+	      for (j=0; j<i; j++)
+		if (iters[j] && iters[j]->var->symtree == start->symtree)
+		  return false;
+
+	      iters[i] = NULL;
+	    }
 	  else
 	    {
 	      iters[i] = stack_top->iter;