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.
===================================================================
@@ -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. */
===================================================================
@@ -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