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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 49b8dae11cc92ca876ed1eb72da0d0b9008e1390..12c6b2efdb9ead75ac9677276cd01bef3c7037da 100644 (file)
--- 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 1e4c93193442a91d02f5f55bd5598c8aa4fbfdc5..ff2ac5675cdf65e5a2c9bc69cd45a0b9fc61667f 100644 (file)
--- 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 745f2b135c4f055d6dfa9aa7f518eedba974c39c..4ffcf4ca02e57e27add07c627562e09a18bfd6df 100644 (file)
--- 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 (file)
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