From d809e15a19e634932e93254142dc6ab1e226f45e Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Mon, 14 Nov 2016 17:55:01 +0100 Subject: [PATCH] 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/ChangeLog | 6 ++++++ gcc/fortran/resolve.c | 20 +++++++++++------- gcc/testsuite/ChangeLog | 7 ++++++- gcc/testsuite/gfortran.dg/class_result_3.f90 | 22 ++++++++++++++++++++ 4 files changed, 47 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_result_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b5324f255fa..6c0ede1186f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2016-11-14 Janus Weil + + PR fortran/78300 + * resolve.c (resolve_procedure_interface): Properly handle CLASS-valued + function results. + 2016-11-13 Janus Weil PR fortran/60952 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c85525aabb9..825bb12a517 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) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e9485591659..54eb9b3db08 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,6 +1,11 @@ +2016-11-14 Janus Weil + + PR fortran/78300 + * gfortran.dg/class_result_3.f90: New test. + 2016-11-14 Prasad Ghangal Richard Biener - + * gcc.dg/gimplefe-1.c: New testcase. * gcc.dg/gimplefe-2.c: Likewise. * gcc.dg/gimplefe-3.c: Likewise. diff --git a/gcc/testsuite/gfortran.dg/class_result_3.f90 b/gcc/testsuite/gfortran.dg/class_result_3.f90 new file mode 100644 index 00000000000..39d6c1ef777 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_result_3.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! +! PR 78300: [OOP] Failure to compile a F03 code with an optional dummy procedure argument +! +! Contributed by DIL + + implicit none + + type gfc_cont_elem_t + end type + + contains + + function gfc_copy_i() result(clone) + class(gfc_cont_elem_t), pointer:: clone + end + + subroutine ContElemConstruct(copy_constr_func) + procedure(gfc_copy_i) :: copy_constr_func + end + +end -- 2.30.2