From d809e15a19e634932e93254142dc6ab1e226f45e Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Mon, 14 Nov 2016 17:55:01 +0100 Subject: re PR fortran/78300 ([OOP] Failure to compile a F03 code with an optional dummy procedure argument) 2016-11-14 Janus Weil PR fortran/78300 * resolve.c (resolve_procedure_interface): Properly handle CLASS-valued function results. 2016-11-14 Janus Weil PR fortran/78300 * gfortran.dg/class_result_3.f90: New test. From-SVN: r242392 --- gcc/fortran/resolve.c | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) (limited to 'gcc/fortran/resolve.c') diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c85525a..825bb12 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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) { -- cgit v1.1