Patchwork [fortran] PR 50554 - redefinition of index variable with inquire(iolength=...)

login
register
mail settings
Submitter Thomas Koenig
Date June 27, 2013, 6:52 p.m.
Message ID <51CC89EB.4010703@netcologne.de>
Download mbox | patch
Permalink /patch/255121/
State New
Headers show

Comments

Thomas Koenig - June 27, 2013, 6:52 p.m.
Hello world,

the attached patch raises an error if an index variable is redefined
with inquire(iolength=...).

OK for trunk?

	Thomas

2013-06-27  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/50554
         * frontend-passes.c (doloop_code): Check do loop variables for
         EXEC_IOLENGTH.
         (do_function):  Whitespace fix.
         (gfc_code_walker):  Handle EXEC_IOLENGTH.

2013-06-27  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/50554
         * gfortran.dg/do_check_9.f90:  New test.

Patch

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 200132)
+++ frontend-passes.c	(Arbeitskopie)
@@ -1615,6 +1615,7 @@  doloop_code (gfc_code **c, int *walk_subtrees ATTR
   int i;
   gfc_formal_arglist *f;
   gfc_actual_arglist *a;
+  gfc_symbol *do_sym;
 
   co = *c;
 
@@ -1654,8 +1655,6 @@  doloop_code (gfc_code **c, int *walk_subtrees ATTR
 	{
 	  for (i=0; i<doloop_level; i++)
 	    {
-	      gfc_symbol *do_sym;
-	      
 	      if (doloop_list[i] == NULL)
 		break;
 
@@ -1683,6 +1682,27 @@  doloop_code (gfc_code **c, int *walk_subtrees ATTR
 	}
       break;
 
+    case EXEC_IOLENGTH:
+
+      for (i=0; i<doloop_level; i++)
+	{
+	  gfc_expr *iolength;
+
+	  if (doloop_list[i] == NULL)
+	    break;
+
+	  do_sym = doloop_list[i]->ext.iterator->var->symtree->n.sym;
+
+	  iolength = co->ext.inquire->iolength;
+	  if (iolength != NULL && iolength->symtree->n.sym == do_sym)
+	    gfc_error_now ("Variable '%s' at %L cannot be redefined "
+			   "inside loop beginning at %L", do_sym->name,
+			   &iolength->where, &doloop_list[i]->loc);
+
+	}
+
+      break;
+
     default:
       break;
     }
@@ -1724,7 +1744,6 @@  do_function (gfc_expr **e, int *walk_subtrees ATTR
       for (i=0; i<doloop_level; i++)
 	{
 	  gfc_symbol *do_sym;
-	 
     
 	  if (doloop_list[i] == NULL)
 	    break;
@@ -2057,6 +2076,10 @@  gfc_code_walker (gfc_code **c, walk_code_fn_t code
 	      WALK_SUBEXPR (co->ext.inquire->round);
 	      break;
 
+	    case EXEC_IOLENGTH:
+	      WALK_SUBEXPR (co->ext.inquire->iolength);
+	      break;
+
 	    case EXEC_WAIT:
 	      WALK_SUBEXPR (co->ext.wait->unit);
 	      WALK_SUBEXPR (co->ext.wait->iostat);