From patchwork Sat Sep  4 16:51:45 2010
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: [Fortran] PR 45530: Reorder namelist checking to avoid endless loop
From: Tobias Burnus <burnus@net-b.de>
X-Patchwork-Id: 63799
Message-Id: <4C827921.5010406@net-b.de>
To: gcc patches <gcc-patches@gcc.gnu.org>, gfortran <fortran@gcc.gnu.org>
Date: Sat, 04 Sep 2010 18:51:45 +0200

Hi all,

the attached patch is rather obvious: Without the patch, gfortran ends 
up in an endless loop derived_inaccessible before it can reject the test 
case because of pointer components.

Well, if one reverts the checking order, the code is rejected before one 
enters the endless loop...

Build on x86-64-linux and currently regtesting.
I plan to commit the patch to 4.6 and 4.5 as obvious - if there are no 
test suite failures and no one objects.

Tobias


2010-09-04  Tobias Burnus  <burnus@net-b.de>

        PR fortran/45530
	* resolve.c (resolve_fl_namelist): Change constraint checking
	order to prevent endless loop.

2010-09-04  Tobias Burnus  <burnus@net-b.de>

        PR fortran/45530
	* gfortran.dg/namelist_63.f90: New.

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 163859)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -11566,6 +11566,46 @@ resolve_fl_namelist (gfc_symbol *sym)
   gfc_namelist *nl;
   gfc_symbol *nlsym;
 
+  for (nl = sym->namelist; nl; nl = nl->next)
+    {
+      /* Reject namelist arrays of assumed shape.  */
+      if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE
+	  && gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' "
+			     "must not have assumed shape in namelist "
+			     "'%s' at %L", nl->sym->name, sym->name,
+			     &sym->declared_at) == FAILURE)
+	    return FAILURE;
+
+      /* Reject namelist arrays that are not constant shape.  */
+      if (is_non_constant_shape_array (nl->sym))
+	{
+	  gfc_error ("NAMELIST array object '%s' must have constant "
+		     "shape in namelist '%s' at %L", nl->sym->name,
+		     sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+
+      /* Namelist objects cannot have allocatable or pointer components.  */
+      if (nl->sym->ts.type != BT_DERIVED)
+	continue;
+
+      if (nl->sym->ts.u.derived->attr.alloc_comp)
+	{
+	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
+		     "have ALLOCATABLE components",
+		     nl->sym->name, sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+
+      if (nl->sym->ts.u.derived->attr.pointer_comp)
+	{
+	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
+		     "have POINTER components", 
+		     nl->sym->name, sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+    }
+
   /* Reject PRIVATE objects in a PUBLIC namelist.  */
   if (gfc_check_access(sym->attr.access, sym->ns->default_access))
     {
@@ -11607,46 +11647,6 @@ resolve_fl_namelist (gfc_symbol *sym)
 	}
     }
 
-  for (nl = sym->namelist; nl; nl = nl->next)
-    {
-      /* Reject namelist arrays of assumed shape.  */
-      if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE
-	  && gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' "
-			     "must not have assumed shape in namelist "
-			     "'%s' at %L", nl->sym->name, sym->name,
-			     &sym->declared_at) == FAILURE)
-	    return FAILURE;
-
-      /* Reject namelist arrays that are not constant shape.  */
-      if (is_non_constant_shape_array (nl->sym))
-	{
-	  gfc_error ("NAMELIST array object '%s' must have constant "
-		     "shape in namelist '%s' at %L", nl->sym->name,
-		     sym->name, &sym->declared_at);
-	  return FAILURE;
-	}
-
-      /* Namelist objects cannot have allocatable or pointer components.  */
-      if (nl->sym->ts.type != BT_DERIVED)
-	continue;
-
-      if (nl->sym->ts.u.derived->attr.alloc_comp)
-	{
-	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
-		     "have ALLOCATABLE components",
-		     nl->sym->name, sym->name, &sym->declared_at);
-	  return FAILURE;
-	}
-
-      if (nl->sym->ts.u.derived->attr.pointer_comp)
-	{
-	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
-		     "have POINTER components", 
-		     nl->sym->name, sym->name, &sym->declared_at);
-	  return FAILURE;
-	}
-    }
-
 
   /* 14.1.2 A module or internal procedure represent local entities
      of the same type as a namelist member and so are not allowed.  */
Index: gcc/testsuite/gfortran.dg/namelist_63.f90
===================================================================
--- gcc/testsuite/gfortran.dg/namelist_63.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/namelist_63.f90	(Revision 0)
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR fortran/45530
+!
+! Contributed by david.sagan@gmail.com
+!
+program test
+implicit none
+
+type c_struct
+  type (g_struct), pointer :: g
+end type
+
+type g_struct
+  type (p_struct), pointer :: p
+end type
+
+type p_struct
+  type (region_struct), pointer :: r
+end type
+
+type region_struct
+  type (p_struct) plot
+end type
+
+type (c_struct) curve(10)
+namelist / params / curve ! { dg-error "NAMELIST object .curve. in namelist .params. at .1. cannot have POINTER components" }
+end program