re PR fortran/29373 (implicit type declaration and contained function clash)

2006-10-13 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/29373
	* decl.c (get_proc_name, gfc_match_function_decl): Add
	attr.implicit_type to conditions that throw error for
	existing explicit interface and that allow new type-
	spec to be applied.

	PR fortran/29407
	* resolve.c (resolve_fl_namelist): Do not check for
	namelist/procedure conflict, if the symbol corresponds
	to a good local variable declaration.

	PR fortran/27701
	* decl.c (get_proc_name): Replace the detection of a declared
	procedure by the presence of a formal argument list by the
	attributes of the symbol and the presence of an explicit
	interface.

	PR fortran/29232
	* resolve.c (resolve_fl_variable): See if the host association
	of a derived type is blocked by the presence of another type I
	object in the current namespace.

	PR fortran/29364
	* resolve.c (resolve_fl_derived): Check for the presence of
	the derived type for a derived type component.

	PR fortran/24398
	* module.c (gfc_use_module): Check that the first words in a
	module file are 'GFORTRAN module'.

	PR fortran/29422
	* resolve.c (resolve_transfer): Test functions for suitability
	for IO, as well as variables.

	PR fortran/29428
	* trans-expr.c (gfc_trans_scalar_assign): Remove nullify of
	rhs expression.


2006-10-13 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/29373
	* gfortran.dg/implicit_9.f90: New test.

	PR fortran/29407
	* gfortran.dg/namelist_25.f90: New test.

	PR fortran/27701
	* gfortran.dg/same_name_2.f90: New test.

	PR fortran/29232
	* gfortran.dg/host_assoc_types_1.f90: New test.

	PR fortran/29364
	* gfortran.dg/missing_derived_type_1.f90: New test.
	* gfortran.dg/implicit_actual.f90: Comment out USE GLOBAL.

	PR fortran/29422
	* gfortran.dg/alloc_comp_constraint_4.f90: New test.

	PR fortran/29428
	* gfortran.dg/alloc_comp_assign_5.f90: New test.

From-SVN: r117692

5 files changed, 98 insertions, 22 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9bf791b..2708abb 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,43 @@
+2006-10-13 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29373
+	* decl.c (get_proc_name, gfc_match_function_decl): Add
+	attr.implicit_type to conditions that throw error for
+	existing explicit interface and that allow new type-
+	spec to be applied.
+
+	PR fortran/29407
+	* resolve.c (resolve_fl_namelist): Do not check for
+	namelist/procedure conflict, if the symbol corresponds
+	to a good local variable declaration.
+
+	PR fortran/27701
+	* decl.c (get_proc_name): Replace the detection of a declared
+	procedure by the presence of a formal argument list by the
+	attributes of the symbol and the presence of an explicit
+	interface.
+
+	PR fortran/29232
+	* resolve.c (resolve_fl_variable): See if the host association
+	of a derived type is blocked by the presence of another type I
+	object in the current namespace.
+
+	PR fortran/29364
+	* resolve.c (resolve_fl_derived): Check for the presence of
+	the derived type for a derived type component.
+
+	PR fortran/24398
+	* module.c (gfc_use_module): Check that the first words in a
+	module file are 'GFORTRAN module'.
+
+	PR fortran/29422
+	* resolve.c (resolve_transfer): Test functions for suitability
+	for IO, as well as variables.
+
+	PR fortran/29428
+	* trans-expr.c (gfc_trans_scalar_assign): Remove nullify of
+	rhs expression.
+
 2006-10-13  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	PR fortran/29391
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index a9a11c0..02dc38c 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -635,7 +635,8 @@ get_proc_name (const char *name, gfc_symbol ** result,
 	 accessible names.  */
       if (sym->attr.flavor != 0
 	    && sym->attr.proc != 0
-	    && sym->formal)
+	    && (sym->attr.subroutine || sym->attr.function)
+	    && sym->attr.if_source != IFSRC_UNKNOWN)
 	gfc_error_now ("Procedure '%s' at %C is already defined at %L",
 		       name, &sym->declared_at);
 
@@ -643,6 +644,7 @@ get_proc_name (const char *name, gfc_symbol ** result,
 	 signature for this is that ts.kind is set.  Legitimate
 	 references only set ts.type.  */
       if (sym->ts.kind != 0
+	    && !sym->attr.implicit_type
 	    && sym->attr.proc == 0
 	    && gfc_current_ns->parent != NULL
 	    && sym->attr.access == 0
@@ -2679,7 +2681,9 @@ gfc_match_function_decl (void)
       || copy_prefix (&sym->attr, &sym->declared_at) == FAILURE)
     goto cleanup;
 
-  if (current_ts.type != BT_UNKNOWN && sym->ts.type != BT_UNKNOWN)
+  if (current_ts.type != BT_UNKNOWN
+	&& sym->ts.type != BT_UNKNOWN
+	&& !sym->attr.implicit_type)
     {
       gfc_error ("Function '%s' at %C already has a type of %s", name,
 		 gfc_basic_typename (sym->ts.type));
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 599342e..f525ab6 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -3790,7 +3790,7 @@ gfc_use_module (void)
 {
   char *filename;
   gfc_state_data *p;
-  int c, line;
+  int c, line, start;
 
   filename = (char *) alloca(strlen(module_name) + strlen(MODULE_EXTENSION)
 			     + 1);
@@ -3805,15 +3805,23 @@ gfc_use_module (void)
   iomode = IO_INPUT;
   module_line = 1;
   module_column = 1;
+  start = 0;
 
-  /* Skip the first two lines of the module.  */
-  /* FIXME: Could also check for valid two lines here, instead.  */
+  /* Skip the first two lines of the module, after checking that this is
+     a gfortran module file.  */
   line = 0;
   while (line < 2)
     {
       c = module_char ();
       if (c == EOF)
 	bad_module ("Unexpected end of module");
+      if (start++ < 2)
+	parse_name (c);
+      if ((start == 1 && strcmp (atom_name, "GFORTRAN") != 0)
+	    || (start == 2 && strcmp (atom_name, " module") != 0))
+	gfc_fatal_error ("File '%s' opened at %C is not a GFORTRAN module "
+			  "file", filename);
+
       if (c == '\n')
 	line++;
     }
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e795044..6b9062d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4167,7 +4167,8 @@ resolve_transfer (gfc_code * code)
 
   exp = code->expr;
 
-  if (exp->expr_type != EXPR_VARIABLE)
+  if (exp->expr_type != EXPR_VARIABLE
+	&& exp->expr_type != EXPR_FUNCTION)
     return;
 
   sym = exp->symtree->n.sym;
@@ -5384,6 +5385,24 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
       return FAILURE;
     }
 
+  /* Check to see if a derived type is blocked from being host associated
+     by the presence of another class I symbol in the same namespace.
+     14.6.1.3 of the standard and the discussion on comp.lang.fortran.  */
+  if (sym->ts.type == BT_DERIVED && sym->ns != sym->ts.derived->ns)
+    {
+      gfc_symbol *s;
+      gfc_find_symbol (sym->ts.derived->name, sym->ns, 0, &s);
+      if (s && (s->attr.flavor != FL_DERIVED
+		  || !gfc_compare_derived_types (s, sym->ts.derived)))
+	{
+	  gfc_error ("The type %s cannot be host associated at %L because "
+		     "it is blocked by an incompatible object of the same "
+		     "name at %L", sym->ts.derived->name, &sym->declared_at,
+		     &s->declared_at);
+	  return FAILURE;
+	}
+    }
+
   /* 4th constraint in section 11.3:  "If an object of a type for which
      component-initialization is specified (R429) appears in the
      specification-part of a module and does not have the ALLOCATABLE
@@ -5577,6 +5596,15 @@ resolve_fl_derived (gfc_symbol *sym)
 	    }
 	}
 
+      if (c->ts.type == BT_DERIVED && c->pointer
+	    && c->ts.derived->components == NULL)
+	{
+	  gfc_error ("The pointer component '%s' of '%s' at %L is a type "
+		     "that has not been declared", c->name, sym->name,
+		     &c->loc);
+	  return FAILURE;
+	}
+
       if (c->pointer || c->allocatable ||  c->as == NULL)
 	continue;
 
@@ -5668,16 +5696,18 @@ resolve_fl_namelist (gfc_symbol *sym)
      same message has been used.  */
   for (nl = sym->namelist; nl; nl = nl->next)
     {
+      if (nl->sym->ts.kind != 0 && nl->sym->attr.flavor == FL_VARIABLE)
+	continue;
       nlsym = NULL;
-	if (sym->ns->parent && nl->sym && nl->sym->name)
-	  gfc_find_symbol (nl->sym->name, sym->ns->parent, 0, &nlsym);
-	if (nlsym && nlsym->attr.flavor == FL_PROCEDURE)
-	  {
-	    gfc_error ("PROCEDURE attribute conflicts with NAMELIST "
-		       "attribute in '%s' at %L", nlsym->name,
-		       &sym->declared_at);
-	    return FAILURE;
-	  }
+      if (sym->ns->parent && nl->sym && nl->sym->name)
+	gfc_find_symbol (nl->sym->name, sym->ns->parent, 0, &nlsym);
+      if (nlsym && nlsym->attr.flavor == FL_PROCEDURE)
+	{
+	  gfc_error ("PROCEDURE attribute conflicts with NAMELIST "
+		     "attribute in '%s' at %L", nlsym->name,
+		     &sym->declared_at);
+	  return FAILURE;
+	}
     }
 
   return SUCCESS;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index c5a4be3..875092f 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3261,19 +3261,13 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
 			   fold_convert (TREE_TYPE (lse->expr), rse->expr));
 
       /* Do a deep copy if the rhs is a variable, if it is not the
-	 same as the lhs.  Otherwise, nullify the data fields so that the
-	 lhs retains the allocated resources.  */
+	 same as the lhs.  */
       if (r_is_var)
 	{
 	  tmp = gfc_copy_alloc_comp (ts.derived, rse->expr, lse->expr, 0);
 	  tmp = build3_v (COND_EXPR, cond, build_empty_stmt (), tmp);
 	  gfc_add_expr_to_block (&block, tmp);
 	}
-      else
-	{
-	  tmp = gfc_nullify_alloc_comp (ts.derived, rse->expr, 0);
-	  gfc_add_expr_to_block (&block, tmp);
-	}
     }
   else
     {