[patch, fortran] PR16940 - module interfaces to contained procedures

[Paul Thomas]

Tobi,

> Instead of your fix, we should correctly identify the symbol to use for
> max_location as the one from the module included by the host (in this case 
> the
> program) when parsing the CALL.  I have no idea what's going wrong, 
> though,
> except that generic interfaces seem to be full of errors.
>

I believe that this version, whilst perhaps not optimal, is OK.  Notice that 
it treats all such interfaces, whether implicit none is set or not and 
correctly associates the symtree with the interface symbol.  Ideally, we 
would fix the parse/symbol.c error but, for the moment, I am blowed if I can 
see what it is.  At very least, this patch does no harm because it does not 
interfere with a proper fix and it does deal with a bug that has been 
reported a good number of times.  In any case, it does do what resolve 
does.....

I would propose committing this patch, whilst raising a PR for some brave 
soul (I am rooting around in the right places but do not claim to be brave!) 
to fix the real error.

As usual, find a properly tabbed version attached.

Paul T

*** resolve.c.bak Thu Jun 30 11:57:22 2005
--- gcc-4.1-20050522/gcc/fortran/resolve.c Sun Jul  3 15:20:28 2005
*************** resolve_symbol (gfc_symbol * sym)
*** 4031,4036 ****
--- 4031,4062 ----
    int i;
    const char *whynot;
    gfc_namelist *nl;
+   gfc_symtree * symtree;
+   gfc_symtree * this_symtree;
+   gfc_namespace * ns;
+
+   /* If we find that the symbol is an interface in one of the
+      parent namespaces, locate its symtree in this namespace,
+      free the symbol and set the symtree to point to the
+      interface; remembering to increment the references.  */
+   if (sym->ts.type == BT_UNKNOWN
+  && sym->attr.flavor == FL_UNKNOWN)
+     {
+       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);
+        gfc_free_symbol (sym);
+        symtree->n.sym->refs++;
+        this_symtree->n.sym = symtree->n.sym;
+        return;
+      }
+  }
+     }

    if (sym->attr.flavor == FL_UNKNOWN)
      { 
-------------- next part --------------
A non-text attachment was scrubbed...
Name: resolve.diff
Type: application/octet-stream
Size: 1147 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/gcc-patches/attachments/20050703/88817f73/attachment.obj>