From ff6903288d96aa1d28ae4912b1270985475f3ba8 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Thu, 11 Feb 2021 13:24:50 +0000 Subject: [PATCH] Fortran: Fix calls to associate name typebound subroutines [PR98897]. 2021-02-11 Paul Thomas gcc/fortran PR fortran/98897 * match.c (gfc_match_call): Include associate names as possible entities with typebound subroutines. The target needs to be resolved for the type. gcc/testsuite/ PR fortran/98897 * gfortran.dg/typebound_call_32.f90: New test. --- gcc/fortran/match.c | 14 +++++-- .../gfortran.dg/typebound_call_32.f90 | 39 +++++++++++++++++++ 2 files changed, 49 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/typebound_call_32.f90 diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index f0469e25da6..2df6191d7e6 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -4999,10 +4999,16 @@ gfc_match_call (void) sym = st->n.sym; /* If this is a variable of derived-type, it probably starts a type-bound - procedure call. */ - if ((sym->attr.flavor != FL_PROCEDURE - || gfc_is_function_return_value (sym, gfc_current_ns)) - && (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)) + procedure call. Associate variable targets have to be resolved for the + target type. */ + if (((sym->attr.flavor != FL_PROCEDURE + || gfc_is_function_return_value (sym, gfc_current_ns)) + && (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)) + || + (sym->assoc && sym->assoc->target + && gfc_resolve_expr (sym->assoc->target) + && (sym->assoc->target->ts.type == BT_DERIVED + || sym->assoc->target->ts.type == BT_CLASS))) return match_typebound_call (st); /* If it does not seem to be callable (include functions so that the diff --git a/gcc/testsuite/gfortran.dg/typebound_call_32.f90 b/gcc/testsuite/gfortran.dg/typebound_call_32.f90 new file mode 100644 index 00000000000..88ddae494c2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_call_32.f90 @@ -0,0 +1,39 @@ +! { dg-do run } +! +! Test the fix for PR98897 in which typebound subroutines of associate names +! were not recognised in a call. Functions were OK but this is tested below. +! +! Contributed by Damian Rouson +! +module output_data_m + implicit none + + type output_data_t + integer, private :: i = 0 + contains + procedure output, return_value + end type + + +contains + subroutine output(self) + implicit none + class(output_data_t) self + self%i = 1234 + end subroutine + + integer function return_value(self) + implicit none + class(output_data_t) self + return_value = self%i + end function +end module + + use output_data_m + implicit none + associate(output_data => output_data_t()) + call output_data%output + if (output_data%return_value() .ne. 1234) stop 1 + end associate +end + -- 2.30.2