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.
This commit is contained in:
parent
22a6d99d0a
commit
ff6903288d
@ -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
|
||||
|
39
gcc/testsuite/gfortran.dg/typebound_call_32.f90
Normal file
39
gcc/testsuite/gfortran.dg/typebound_call_32.f90
Normal file
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user