re PR fortran/31818 (Wrongly accepts namelists with assumed-shape arrays)

gcc/fortran:
2007-07-28  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/31818
	PR fortran/32876
	PR fortran/32905
	* gfortran.h (symbol_attribute): Added bits for pointer_comp, private_comp.
	* parse.c (parse_derived): Set pointer_comp/private_comp bits if the derived
	type ultimately contains pointer components or private components.
	* module.c (ab_attribute): New values AB_POINTER_COMP, AB_PRIVATE_COMP.
	(attr_bits): Added names for new ab_attributes.
	(mio_symbol_attribute): Save/restore new attribute bits in modules.
	* match.c (gfc_match_namelist): Removed check for namelist objects of assumed
	shape.
	* resolve.c (resolve_fl_namelist): Added check for pointer or private
	components in nested types. Added check for namelist objects of assumed
	shape.

gcc/testsuite:
2007-07-28  Daniel Franke  <franke.daniel@gmail.com>

	* gfortran.dg/namelist_5.f90: Adjusted error message.
	* gfortran.dg/assumed_shape_nml.f90: Renamed to ...
	* gfortran.dg/namelist_31.f90: ... this. Removed dg-warning directive.
	* gfortran.dg/assumed_size_nml.f90: Renamed to ...
	* gfortran.dg/namelist_32.f90: ... this.

	PR fortran/32876
	* gfortran.dg/namelist_33.f90: New test.

	PR fortran/32905
	* gfortran.dg/namelist_34.f90: New test.

	PR fortran/31818
	* gfortran.dg/namelist_35.f90: New test.

From-SVN: r127014

1 files changed, 51 insertions, 21 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1a5c001..a7edd16 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7027,45 +7027,75 @@ resolve_fl_namelist (gfc_symbol *sym)
     {
       for (nl = sym->namelist; nl; nl = nl->next)
 	{
-	  if (!nl->sym->attr.use_assoc
-	      && !(sym->ns->parent == nl->sym->ns)
-	      && !(sym->ns->parent
-		   && sym->ns->parent->parent == nl->sym->ns)
-	      && !gfc_check_access(nl->sym->attr.access,
-				   nl->sym->ns->default_access))
+	  if (nl->sym->attr.use_assoc
+	      || (sym->ns->parent == nl->sym->ns)
+	      || (sym->ns->parent
+		  && sym->ns->parent->parent == nl->sym->ns))
+	    continue;
+
+	  if (!gfc_check_access(nl->sym->attr.access,
+				nl->sym->ns->default_access))
 	    {
-	      gfc_error ("PRIVATE symbol '%s' cannot be member of "
-			 "PUBLIC namelist at %L", nl->sym->name,
-			 &sym->declared_at);
+	      gfc_error ("NAMELIST object '%s' was declared PRIVATE and "
+			 "cannot be member of PUBLIC namelist '%s' at %L",
+			 nl->sym->name, sym->name, &sym->declared_at);
+	      return FAILURE;
+	    }
+
+	  if (nl->sym->ts.type == BT_DERIVED
+	      && !gfc_check_access (nl->sym->ts.derived->attr.private_comp
+				    ? ACCESS_PRIVATE : ACCESS_UNKNOWN,
+				    nl->sym->ns->default_access))
+	    {
+	      gfc_error ("NAMELIST object '%s' has PRIVATE components and "
+			 "cannot be a member of PUBLIC namelist '%s' at %L",
+			 nl->sym->name, sym->name, &sym->declared_at);
 	      return FAILURE;
 	    }
 	}
     }
 
-  /* Reject namelist arrays that are not constant shape.  */
   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 ("The array '%s' must have constant shape to be "
-		     "a NAMELIST object at %L", nl->sym->name,
-		     &sym->declared_at);
+	  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 components.  */
-  for (nl = sym->namelist; nl; nl = nl->next)
-    {
-      if (nl->sym->ts.type == BT_DERIVED
-	  && nl->sym->ts.derived->attr.alloc_comp)
+      /* Namelist objects cannot have allocatable or pointer components.  */
+      if (nl->sym->ts.type != BT_DERIVED)
+	continue;
+
+      if (nl->sym->ts.derived->attr.alloc_comp)
 	{
-	  gfc_error ("NAMELIST object '%s' at %L cannot have ALLOCATABLE "
-		     "components", nl->sym->name, &sym->declared_at);
+	  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.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.  */
   for (nl = sym->namelist; nl; nl = nl->next)