re PR fortran/16940 (Failure to perform host association correctly)

2005-07-19 Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/16940
	* resolve.c (resolve_symbol): A symbol with FL_UNKNOWN
	is matched against interfaces in parent namespaces. If there
	the symtree is set to point to the interface.

2005-07-19 Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/16940
	* gfortran.dg/module_interface_1.f90: New test.

From-SVN: r102167

gcc/fortran/ChangeLog

+2005-07-19 Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/16940
+	* resolve.c (resolve_symbol): A symbol with FL_UNKNOWN
+	is matched against interfaces in parent namespaces. If there
+	the symtree is set to point to the interface.
+
 2005-07-16  David Edelsohn  <edelsohn@gnu.org>
 
 	PR fortran/21730

gcc/fortran/resolve.c

@@ -4031,9 +4031,34 @@ resolve_symbol (gfc_symbol * sym)
   int i;
   const char *whynot;
   gfc_namelist *nl;
+  gfc_symtree * symtree;
+  gfc_symtree * this_symtree;
+  gfc_namespace * ns;
 
   if (sym->attr.flavor == FL_UNKNOWN)
     {
+
+    /* If we find that a flavorless symbol is an interface in one of the
+       parent namespaces, find its symtree in this namespace, free the
+       symbol and set the symtree to point to the interface symbol.  */
+      for (ns = gfc_current_ns->parent; ns; ns = ns->parent)
+	{
+	  symtree = gfc_find_symtree (ns->sym_root, sym->name);
+	  if (symtree && symtree->n.sym->generic)
+	    {
+	      this_symtree = gfc_find_symtree (gfc_current_ns->sym_root,
+					       sym->name);
+	      sym->refs--;
+	      if (!sym->refs)
+		gfc_free_symbol (sym);
+	      symtree->n.sym->refs++;
+	      this_symtree->n.sym = symtree->n.sym;
+	      return;
+	    }
+	}
+
+      /* Otherwise give it a flavor according to such attributes as
+	 it has.  */
       if (sym->attr.external == 0 && sym->attr.intrinsic == 0)
 	sym->attr.flavor = FL_VARIABLE;
       else

gcc/testsuite/ChangeLog

+2005-07-19 Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/16940
+	* gfortran.dg/module_interface_1.f90: New test.
+
 2005-07-19  Danny Berlin <dberlin@dberlin.org>
 	    Kenneth Zadeck <zadeck@naturalbridge.com>
 

gcc/testsuite/gfortran.dg/module_interface_1.f90

+! { dg-do run }
+! This tests the fix for PR16940, module interfaces to
+! contained functions caused ICEs.
+! This is a simplified version of the example in the PR
+! discussion, which was due to L.Meissner.
+!
+! Submitted by Paul Thomas  pault@gcc.gnu.org
+!
+  module Max_Loc_Mod
+    implicit none
+    interface Max_Location
+      module procedure I_Max_Loc
+    end interface
+  contains
+    function I_Max_Loc (Vector) result(Ans)
+      integer, intent (in), dimension(:) :: Vector
+      integer, dimension(1) :: Ans
+      Ans = maxloc(Vector)
+      return
+    end function I_Max_Loc
+  end module Max_Loc_Mod
+  program module_interface
+    use Max_Loc_Mod
+    implicit none
+    integer :: Vector (7)
+    Vector = (/1,6,3,5,19,1,2/)
+    call Selection_Sort (Vector)
+  contains
+    subroutine Selection_Sort (Unsorted)
+      integer, intent (in), dimension(:) :: Unsorted
+      integer, dimension (1) :: N
+      N = Max_Location (Unsorted)
+      if (N(1).ne.5) call abort ()
+      return
+    end subroutine Selection_Sort
+  end program module_interface
\ No newline at end of file