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

1 files changed, 40 insertions, 10 deletions

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;