diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2021-02-11 13:24:50 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2021-02-11 13:25:04 +0000 |
| commit | ff6903288d96aa1d28ae4912b1270985475f3ba8 (patch) | |
| tree | e881839a198422bcdc2c84c10fc9fdc0188a7689 /gcc | |
| parent | 22a6d99d0a0d383856440ea479b4a9edabf23961 (diff) | |
| download | gcc-ff6903288d96aa1d28ae4912b1270985475f3ba8.zip gcc-ff6903288d96aa1d28ae4912b1270985475f3ba8.tar.gz gcc-ff6903288d96aa1d28ae4912b1270985475f3ba8.tar.bz2 | |
Fortran: Fix calls to associate name typebound subroutines [PR98897].
2021-02-11 Paul Thomas <pault@gcc.gnu.org>
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.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/match.c | 14 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/typebound_call_32.f90 | 39 |
2 files changed, 49 insertions, 4 deletions
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index f0469e2..2df6191d 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 0000000..88ddae4 --- /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 <damian@sourceryinstitute.org> +! +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 + |