2016-11-14 9:56 GMT+01:00 Janus Weil <[email protected]>:
> Hi Steve,
>
>> The attach patch allows a procedure with a class result to
>> be an actual argument to subprogram where the dummy argument
>> expected to be a class. OK to commit?
>
> that patch actually does not look quite right to me. Does it survive a
> regtest?
>
> I think one should rather check why the class_ok attribute is not set
> in the first place, any maybe apply a fix in gfc_build_class_symbol.
After looking into this a little bit more, I found that the culprit
seems to be 'resolve_procedure_interface', which does not properly
copy the 'class_ok' attribute. I propose the attached patch to fix
this (regtesting right now) ...
Cheers,
Janus
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (Revision 242380)
+++ gcc/fortran/resolve.c (Arbeitskopie)
@@ -214,27 +214,33 @@ resolve_procedure_interface (gfc_symbol *sym)
if (ifc->result)
{
sym->ts = ifc->result->ts;
+ sym->attr.allocatable = ifc->result->attr.allocatable;
+ sym->attr.pointer = ifc->result->attr.pointer;
+ sym->attr.dimension = ifc->result->attr.dimension;
+ sym->attr.class_ok = ifc->result->attr.class_ok;
+ sym->as = gfc_copy_array_spec (ifc->result->as);
sym->result = sym;
}
else
- sym->ts = ifc->ts;
+ {
+ sym->ts = ifc->ts;
+ sym->attr.allocatable = ifc->attr.allocatable;
+ sym->attr.pointer = ifc->attr.pointer;
+ sym->attr.dimension = ifc->attr.dimension;
+ sym->attr.class_ok = ifc->attr.class_ok;
+ sym->as = gfc_copy_array_spec (ifc->as);
+ }
sym->ts.interface = ifc;
sym->attr.function = ifc->attr.function;
sym->attr.subroutine = ifc->attr.subroutine;
- sym->attr.allocatable = ifc->attr.allocatable;
- sym->attr.pointer = ifc->attr.pointer;
sym->attr.pure = ifc->attr.pure;
sym->attr.elemental = ifc->attr.elemental;
- sym->attr.dimension = ifc->attr.dimension;
sym->attr.contiguous = ifc->attr.contiguous;
sym->attr.recursive = ifc->attr.recursive;
sym->attr.always_explicit = ifc->attr.always_explicit;
sym->attr.ext_attr |= ifc->attr.ext_attr;
sym->attr.is_bind_c = ifc->attr.is_bind_c;
- sym->attr.class_ok = ifc->attr.class_ok;
- /* Copy array spec. */
- sym->as = gfc_copy_array_spec (ifc->as);
/* Copy char length. */
if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl)
{
