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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@163862 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 428cd3f..d9dbb73 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/45507

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 9099ada..b35898a 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f5306a9..f55b40e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-09-04  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/45530
+       * gfortran.dg/namelist_63.f90: New.
+
 2010-09-04  Jan Hubicka  <jh@suse.cz>
 
        * gcc.dg/tree-ssa/foldconst-2.c: New testcase.

diff --git a/gcc/testsuite/gfortran.dg/namelist_63.f90 b/gcc/testsuite/gfortran.dg/namelist_63.f90
new file mode 100644 (file)
index 0000000..1d02789
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_63.f90
@@ -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