re PR fortran/47339 (Fortran 2003/2008: Valid NAMELIST rejected; Fortran 95: Invalid namelist objects accepted)

2011-01-26  Tobias Burnus  <burnus@net-b.de>

        PR fortran/47339
        PR fortran/43062
        * match.c (gfc_match_namelist): Allow assumed-length characters.
        * resolve.c (resolve_fl_namelist): Adapt and add error messages.
        * symbol.c (check_conflict): Allow allocatables in NML for
        * F2003.
        * trans-io.c (nml_get_addr_expr,transfer_namelist_element):
        Changes due to that change.

2011-01-26  Tobias Burnus  <burnus@net-b.de>

        PR fortran/47339
        PR fortran/43062
        * fortran.dg/namelist_69.f90: New test.
        * fortran.dg/namelist_70.f90: New test.
        * fortran.dg/namelist_assumed_char.f90: Modify dg-error, augment
        * test.
        * fortran.dg/namelist_3.f90: Adapt test.
        * fortran.dg/namelist_34.f90: Ditto.
        * fortran.dg/namelist_35.f90: Ditto.
        * fortran.dg/namelist_5.f90: Ditto.
        * fortran.dg/namelist_63.f90: Ditto.
        * gfortran.dg/alloc_comp_constraint_1.f90: Ditto.

From-SVN: r169282

1 files changed, 47 insertions, 23 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 9f0d675..a4a77ac 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11726,40 +11726,64 @@ resolve_fl_namelist (gfc_symbol *sym)
 
   for (nl = sym->namelist; nl; nl = nl->next)
     {
-      /* Reject namelist arrays of assumed shape.  */
+      /* Check again, the check in match only works if NAMELIST comes
+	 after the decl.  */
+      if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SIZE)
+     	{
+	  gfc_error ("Assumed size array '%s' in namelist '%s' at %L is not "
+		     "allowed", nl->sym->name, sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+
       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 "
+	  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NAMELIST array "
+			     "object '%s' with assumed shape in namelist "
 			     "'%s' at %L", nl->sym->name, sym->name,
 			     &sym->declared_at) == FAILURE)
-	    return 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;
-	}
+      if (is_non_constant_shape_array (nl->sym)
+	  && gfc_notify_std (GFC_STD_F2003,  "Fortran 2003: NAMELIST array "
+			     "object '%s' with nonconstant shape in namelist "
+			     "'%s' at %L", nl->sym->name, sym->name,
+			     &sym->declared_at) == FAILURE)
+	return FAILURE;
 
-      /* Namelist objects cannot have allocatable or pointer components.  */
-      if (nl->sym->ts.type != BT_DERIVED)
-	continue;
+      if (nl->sym->ts.type == BT_CHARACTER
+	  && (nl->sym->ts.u.cl->length == NULL
+	      || !gfc_is_constant_expr (nl->sym->ts.u.cl->length))
+	  && gfc_notify_std (GFC_STD_F2003,  "Fortran 2003: NAMELIST object "
+			     "'%s' with nonconstant character length in "
+			     "namelist '%s' at %L", nl->sym->name, sym->name,
+			     &sym->declared_at) == FAILURE)
+	return FAILURE;
 
-      if (nl->sym->ts.u.derived->attr.alloc_comp)
+      /* FIXME: Once UDDTIO is implemented, the following can be
+	 removed.  */
+      if (nl->sym->ts.type == BT_CLASS)
 	{
-	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
-		     "have ALLOCATABLE components",
-		     nl->sym->name, sym->name, &sym->declared_at);
+	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L is "
+		     "polymorphic and requires a defined input/output "
+		     "procedure", nl->sym->name, sym->name, &sym->declared_at);
 	  return FAILURE;
 	}
 
-      if (nl->sym->ts.u.derived->attr.pointer_comp)
+      if (nl->sym->ts.type == BT_DERIVED
+	  && (nl->sym->ts.u.derived->attr.alloc_comp
+	      || 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);
+	  if (gfc_notify_std (GFC_STD_F2003,  "Fortran 2003: NAMELIST object "
+			      "'%s' in namelist '%s' at %L with ALLOCATABLE "
+			      "or POINTER components", nl->sym->name,
+			      sym->name, &sym->declared_at) == FAILURE)
+	    return FAILURE;
+
+	 /* FIXME: Once UDDTIO is implemented, the following can be
+	    removed.  */
+	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L has "
+		     "ALLOCATABLE or POINTER components and thus requires "
+		     "a defined input/output procedure", nl->sym->name,
+		     sym->name, &sym->declared_at);
 	  return FAILURE;
 	}
     }