Patchwork [Fortran] PR 45530: Reorder namelist checking to avoid endless loop

login
register
mail settings
Submitter Tobias Burnus
Date Sept. 4, 2010, 4:51 p.m.
Message ID <4C827921.5010406@net-b.de>
Download mbox | patch
Permalink /patch/63799/
State New
Headers show

Comments

Tobias Burnus - Sept. 4, 2010, 4:51 p.m.
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
Tobias Burnus - Sept. 4, 2010, 7:48 p.m.
Tobias Burnus wrote:
> 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.

Committed as Revs. 163767 and 163865.

Tobias
Jerry DeLisle - Sept. 5, 2010, 12:06 a.m.
On 09/04/2010 12:48 PM, Tobias Burnus wrote:
> Tobias Burnus wrote:
>> 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.
>
> Committed as Revs. 163767 and 163865.
>
> Tobias
>
Thanks for quick fix.

Jerry

Patch

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