2009-07-24 Janus Weil <janus@gcc.gnu.org>

	PR fortran/40822
	* array.c (gfc_resolve_character_array_constructor): Use new function
	gfc_new_charlen.
	* decl.c (add_init_expr_to_sym,variable_decl,match_char_spec,
	gfc_match_implicit): Ditto.
	* expr.c (gfc_simplify_expr): Ditto.
	* gfortran.h (gfc_new_charlen): New prototype.
	* iresolve.c (check_charlen_present,gfc_resolve_char_achar): Use new
	function gfc_new_charlen.
	* module.c (mio_charlen): Ditto.
	* resolve.c (gfc_resolve_substring_charlen,
	gfc_resolve_character_operator,fixup_charlen,resolve_fl_derived,
	resolve_symbol): Ditto.
	* symbol.c (gfc_new_charlen): New function to create a new gfc_charlen
	structure and add it to a namespace.
	(gfc_copy_formal_args_intr): Make sure ts.cl is present
	for CHARACTER variables.


2009-07-24  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40822
	* gfortran.dg/char_length_16.f90: New.



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

1 files changed, 5 insertions, 27 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 376803d69d9..e09167b1be2 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4012,11 +4012,7 @@ gfc_resolve_substring_charlen (gfc_expr *e)
   e->ts.kind = gfc_default_character_kind;
 
   if (!e->ts.cl)
-    {
-      e->ts.cl = gfc_get_charlen ();
-      e->ts.cl->next = gfc_current_ns->cl_list;
-      gfc_current_ns->cl_list = e->ts.cl;
-    }
+    e->ts.cl = gfc_new_charlen (gfc_current_ns);
 
   if (char_ref->u.ss.start)
     start = gfc_copy_expr (char_ref->u.ss.start);
@@ -4489,9 +4485,7 @@ gfc_resolve_character_operator (gfc_expr *e)
   else if (op2->expr_type == EXPR_CONSTANT)
     e2 = gfc_int_expr (op2->value.character.length);
 
-  e->ts.cl = gfc_get_charlen ();
-  e->ts.cl->next = gfc_current_ns->cl_list;
-  gfc_current_ns->cl_list = e->ts.cl;
+  e->ts.cl = gfc_new_charlen (gfc_current_ns);
 
   if (!e1 || !e2)
     return;
@@ -4530,11 +4524,7 @@ fixup_charlen (gfc_expr *e)
 
     default:
       if (!e->ts.cl)
-	{
-	  e->ts.cl = gfc_get_charlen ();
-	  e->ts.cl->next = gfc_current_ns->cl_list;
-	  gfc_current_ns->cl_list = e->ts.cl;
-	}
+	e->ts.cl = gfc_new_charlen (gfc_current_ns);
 
       break;
     }
@@ -9085,16 +9075,10 @@ resolve_fl_derived (gfc_symbol *sym)
 	      /* Copy char length.  */
 	      if (ifc->ts.cl)
 		{
-		  c->ts.cl = gfc_get_charlen();
+		  c->ts.cl = gfc_new_charlen (sym->ns);
 	          c->ts.cl->resolved = ifc->ts.cl->resolved;
 		  c->ts.cl->length = gfc_copy_expr (ifc->ts.cl->length);
 		  /* TODO: gfc_expr_replace_symbols (c->ts.cl->length, c);*/
-		  /* Add charlen to namespace.  */
-		  /*if (c->formal_ns)
-		    {
-		      c->ts.cl->next = c->formal_ns->cl_list;
-		      c->formal_ns->cl_list = c->ts.cl;
-		    }*/
 		}
 	    }
 	  else if (c->ts.interface->name[0] != '\0')
@@ -9490,16 +9474,10 @@ resolve_symbol (gfc_symbol *sym)
 	  /* Copy char length.  */
 	  if (ifc->ts.cl)
 	    {
-	      sym->ts.cl = gfc_get_charlen();
+	      sym->ts.cl = gfc_new_charlen (sym->ns);
 	      sym->ts.cl->resolved = ifc->ts.cl->resolved;
 	      sym->ts.cl->length = gfc_copy_expr (ifc->ts.cl->length);
 	      gfc_expr_replace_symbols (sym->ts.cl->length, sym);
-	      /* Add charlen to namespace.  */
-	      if (sym->formal_ns)
-		{
-		  sym->ts.cl->next = sym->formal_ns->cl_list;
-		  sym->formal_ns->cl_list = sym->ts.cl;
-		}
 	    }
 	}
       else if (sym->ts.interface->name[0] != '\0')