------- Comment #18 from paulthomas2 at wanadoo dot fr  2006-08-31 18:41 -------
Subject: Re:  [4.1/4.2 Regression]: fold_convert fails
 for Fortran operator

hjl,

>------- Comment #17 from hjl at lucon dot org  2006-08-31 18:28 -------
>The previous gfc_get_derived_type tries to reuse the same TREE_TYPE:
>
>      /* In a module, if an equal derived type is already available in the
>         specification block, use its backend declaration and those of its
>         components, rather than building anew so that potential dummy and
>         actual arguments use the same TREE_TYPE.  Non-module structures,
>         need to be built, if found, because the order of visits to the
>         namespaces is different.  */
>
>      for (ns = derived->ns->parent; ns; ns = ns->parent)
>        {
>          for (dt = ns->derived_types; dt; dt = dt->next)
>            {
>              if (derived->module == NULL
>                    && dt->derived->backend_decl == NULL
>                    && gfc_compare_derived_types (dt->derived, derived))
>                gfc_get_derived_type (dt->derived);
>
>              if (copy_dt_decls_ifequal (dt->derived, derived))
>                break;
>            }
>          if (derived->backend_decl)
>            goto other_equal_dts;
>        }
>
>
>  
>
Yes, I was the author of that part of gfortran.  Knowing it as well as I 
did, I wanted to get rid of it.

Please find attached the patch (relative to trunk) that I am regtesting 
now.  It doesn't permit the host derived type to be renamed yet but it 
does successfully deal with these problems of yours.

Thanks

Paul


Index: gcc/fortran/symbol.c
===================================================================
*** gcc/fortran/symbol.c        (revision 116593)
--- gcc/fortran/symbol.c        (working copy)
*************** gfc_use_derived (gfc_symbol * sym)
*** 1460,1467 ****
        if (!(sym->attr.use_assoc || sym->attr.sequence))
        return sym;

!       /* Derived types must be defined within an interface.  */
!       if (gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY)
        return sym;
      }

--- 1460,1469 ----
        if (!(sym->attr.use_assoc || sym->attr.sequence))
        return sym;

!       /* Derived types must be defined within an interface and are not
!       associated until resolve.c (resolve_symbol).  */
!       if (gfc_current_ns->proc_name->attr.if_source
!           == IFSRC_IFBODY)
        return sym;
      }

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c       (revision 116593)
--- gcc/fortran/resolve.c       (working copy)
*************** resolve_symbol (gfc_symbol * sym)
*** 5681,5686 ****
--- 5681,5715 ----
        }
      }

+   if (sym->ts.type == BT_DERIVED
+       && sym->ns->proc_name->attr.if_source == IFSRC_IFBODY)
+     {
+       gfc_symbol *s;
+ 
+       /* Look in parent namespace for a derived type of the same name.  */
+       if (gfc_find_symbol (sym->ts.derived->name, sym->ns->parent, 1, &s))
+         {
+           gfc_error ("Symbol '%s' at %C is ambiguous", sym->name);
+           return;
+       }
+ 
+       if (s != NULL && gfc_compare_derived_types (sym->ts.derived, s))
+       sym->ts.derived = s;
+       else
+         {
+           gfc_error ("Cannot associate type '%s' at %C", sym->name);
+           return;
+       }
+ 
+       if (sym->ns->proc_name->attr.function
+           && sym->ns->proc_name->ts.type == BT_DERIVED)
+       {
+         sym->ns->proc_name->ts.derived = s;
+         if (sym->ns->proc_name->result != NULL)
+           sym->ns->proc_name->result->ts.derived = s;
+       }
+     }
+ 
    switch (sym->attr.flavor)
      {
      case FL_VARIABLE:


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=28908

Reply via email to