diff mbox

[fortran] Fix PR 66113 error with deeply nested blocks

Message ID 55571D8C.4030801@netcologne.de
State New
Headers show

Commit Message

Thomas Koenig May 16, 2015, 10:35 a.m. UTC 
Hello world,

this (rather obvious) patch fixes array declarations in deeply nested
BLOCKs.

Regression-tested.  OK for trunk?

	Thomas

 2015-05-16  Thomas Koenig  <tkoenig@gcc.gnu.org>

        PR fortran/66113
        * expr.c (is_parent_of_current_ns):  New function.
        (check_restricted):  Use it.

2015-05-16  Thomas Koenig  <tkoenig@gcc.gnu.org>

        PR fortran/66113
        * gfortran.dg/block_14.f90:  New test.

Comments

Mikael Morin May 16, 2015, 10:55 a.m. UTC | #1 
Le 16/05/2015 12:35, Thomas Koenig a écrit :
> Hello world,
> 
> this (rather obvious) patch fixes array declarations in deeply nested
> BLOCKs.
> 
> Regression-tested.  OK for trunk?
> 
OK, thanks.

Mikael
diff mbox

Patch

Index: expr.c
===================================================================
--- expr.c	(Revision 223202)
+++ expr.c	(Arbeitskopie)
@@ -2841,7 +2841,19 @@  check_references (gfc_ref* ref, bool (*checker) (g
   return check_references (ref->next, checker);
 }
 
+/*  Return true if ns is a parent of the current ns.  */
 
+static bool
+is_parent_of_current_ns (gfc_namespace *ns)
+{
+  gfc_namespace *p;
+  for (p = gfc_current_ns->parent; p; p = p->parent)
+    if (ns == p)
+      return true;
+
+  return false;
+}
+
 /* Verify that an expression is a restricted expression.  Like its
    cousin check_init_expr(), an error message is generated if we
    return false.  */
@@ -2929,9 +2941,7 @@  check_restricted (gfc_expr *e)
 	    || sym->attr.dummy
 	    || sym->attr.implied_index
 	    || sym->attr.flavor == FL_PARAMETER
-	    || (sym->ns && sym->ns == gfc_current_ns->parent)
-	    || (sym->ns && gfc_current_ns->parent
-		  && sym->ns == gfc_current_ns->parent->parent)
+	    || is_parent_of_current_ns (sym->ns)
 	    || (sym->ns->proc_name != NULL
 		  && sym->ns->proc_name->attr.flavor == FL_MODULE)
 	    || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns)))