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

4 files changed, 73 insertions, 0 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 49b8dae..12c6b2e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1e4c931..ff2ac56 100644
--- a/gcc/fortran/resolve.c
+++ b/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
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 745f2b1..4ffcf4c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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>
 
diff --git a/gcc/testsuite/gfortran.dg/module_interface_1.f90 b/gcc/testsuite/gfortran.dg/module_interface_1.f90
new file mode 100644
index 0000000..7301f48
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_interface_1.f90
@@ -0,0 +1,36 @@
+! { 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