https://gcc.gnu.org/g:562c002ec702b87e3023fc2d12adb1e1969aee8f
commit r17-5540-g562c002ec702b87e3023fc2d12adb1e1969aee8f Author: Jerry DeLisle <[email protected]> Date: Sat Oct 24 09:47:44 2026 -0400 fortran: Wrong SAME_TYPE_AS through inferred CLASS associate name When the selector of an associate name is a function that has not been parsed yet, the type of the associate name is guessed and corrected later in gfc_fixup_inferred_type_refs. For a CLASS associate name, resolve_variable then also called gfc_fix_class_refs on references such as q%c1(4)%c2 where c2 is a CLASS array component. gfc_fix_class_refs added a '_data' reference in front of the array reference that ends the chain, so the expression was no longer polymorphic and SAME_TYPE_AS was folded to .false. at compile time. The same reference through an associate name whose type is known when it is parsed never goes through this call. Skip gfc_fix_class_refs for inferred-type references, which gfc_fixup_inferred_type_refs has already fixed up. gcc/fortran/ChangeLog: * resolve.cc (resolve_variable): Do not call gfc_fix_class_refs for an inferred-type reference. gcc/testsuite/ChangeLog: * gfortran.dg/associate_92.f90: New test. Diff: --- gcc/fortran/resolve.cc | 3 ++- gcc/testsuite/gfortran.dg/associate_92.f90 | 40 ++++++++++++++++++++++++++++++ 2 files changed, 42 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index f85a84d68e67..ac8ce029749a 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -6717,7 +6717,8 @@ resolve_variable (gfc_expr *e) TODO Understand why class scalar expressions must be excluded. */ if (sym->assoc && !(sym->ts.type == BT_CLASS && e->rank == 0)) { - if (sym->ts.type == BT_CLASS) + /* Inferred-type references are already fixed up above. */ + if (sym->ts.type == BT_CLASS && !IS_INFERRED_TYPE (e)) gfc_fix_class_refs (e); if (!sym->attr.dimension && !sym->attr.codimension && e->ref && e->ref->type == REF_ARRAY) diff --git a/gcc/testsuite/gfortran.dg/associate_92.f90 b/gcc/testsuite/gfortran.dg/associate_92.f90 new file mode 100644 index 000000000000..7433f6794df2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_92.f90 @@ -0,0 +1,40 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! A CLASS array component referenced through an associate name whose CLASS +! type was inferred lost its polymorphism, so SAME_TYPE_AS folded to false. +! +module m + type :: leaf_t + integer :: bar = 0 + end type + type, extends (leaf_t) :: leaf2_t + integer :: baz = 7 + end type + type :: mid_t + class(leaf_t), allocatable :: c2(:) + end type + type :: outer_t + class(mid_t), allocatable :: c1(:) + end type +end module + +program p + use m + implicit none + + associate (q => gfcn ()) + if (.not. same_type_as (q%c1(4)%c2, leaf2_t ())) stop 1 + if (same_type_as (q%c1(4)%c2, leaf_t ())) stop 2 + if (.not. same_type_as (q%c1(4)%c2(2:3), leaf2_t ())) stop 3 + end associate + +contains + + function gfcn () result (y) + class(outer_t), allocatable :: y + allocate (y) + end function +end program + +! { dg-final { scan-tree-dump-times "c2\\._vptr->_hash" 3 "original" } }
