Hi Mikael,
Thanks for the review. You are right on both points. v2 looks up
'_data', '_vptr' and '_len' in the class container of the CLASS
component they follow, and steps through an implicit '_data' to the
declared type for any other name. The walk starts at the associate
name's own container when it is CLASS, so both forms after
gfc_fix_class_refs (explicit '_data' or none) are handled the same way.
v1 only got ref->u.c.sym wrong for those refs (the component pointers
were already right), so nothing failed at run time. The new test
associate_91.f90 uses your foo%class_comp1(4)%class_comp2(:)%bar shape
with a wrong parse-time guess that has the same component names.
That test also exposed a wrong-code bug that trunk has too:
'select type (z => q%a(2)%b(1))' with q an inferred associate name bound
z to the class container instead of its data. The IS_INFERRED_TYPE
branch in trans_associate_var (from PR87477) took the address of the
container as the data pointer. v2 also fixes that, with a check that
skips the branch when se.expr points to a class type.
The change from v1 is the reference loop in
gfc_fixup_inferred_type_refs (resolve.cc) and the one-condition change
in trans_associate_var (trans-stmt.cc); the rest is the two tests.
Regression tested on x86_64.
OK for mainline?
Regards,
Jerry
---
fortran: [PR126968] ICE for wrongly guessed inferred ASSOCIATE type
When an ASSOCIATE selector is a function that has not been parsed yet,
primary.cc types the associate name by guessing: it takes the first
accessible derived type that has a component of the name being
referenced. resolve_assoc_var later corrects the associate name's type
from the resolved selector, and gfc_fixup_inferred_type_refs repaired
the reference chain.
That repair only reset ref->u.c.sym and left ref->u.c.component pointing
into the guessed type. When the guess was wrong, the component and the
type it is referenced from no longer belonged together, which reached
the backend and gave
internal compiler error: in gfc_conv_component_ref, at
fortran/trans-expr.cc:3010
Bind each component reference to the corrected type by looking it up
again by name, walking the whole chain so that nested references are
corrected too. '_data', '_vptr' and '_len' are looked up in the class
container of the CLASS component they follow; any other name after a
CLASS component follows an implicit '_data'. A SELECT TYPE selector
that is an element of such a chain was also bound to the class
container instead of its data, because trans_associate_var took the
address of the container as the data pointer.
Assisted-by: Claude Opus 5.5
PR fortran/126968
gcc/fortran/ChangeLog:
* resolve.cc (gfc_fixup_inferred_type_refs): Look each component
reference up again by name in the corrected derived type and
update both u.c.sym and u.c.component. Walk the whole reference
chain instead of stopping at the first component, looking class
container fields up in the container.
* trans-stmt.cc (trans_associate_var): Do not use the address of
a class container as the data of a scalar CLASS selector.
gcc/testsuite/ChangeLog:
* gfortran.dg/associate_89.f90: New test.
* gfortran.dg/associate_91.f90: New test.
>From fed6a99489c15a655dda9fa96539d791e1b824ec Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Thu, 20 Aug 2026 12:18:35 -0700
Subject: [PATCH] fortran: [PR126968] ICE for wrongly guessed inferred
ASSOCIATE type
When an ASSOCIATE selector is a function that has not been parsed yet,
primary.cc types the associate name by guessing: it takes the first
accessible derived type that has a component of the name being
referenced. resolve_assoc_var later corrects the associate name's type
from the resolved selector, and gfc_fixup_inferred_type_refs repaired
the reference chain.
That repair only reset ref->u.c.sym and left ref->u.c.component pointing
into the guessed type. When the guess was wrong, the component and the
type it is referenced from no longer belonged together, which reached
the backend and gave
internal compiler error: in gfc_conv_component_ref, at
fortran/trans-expr.cc:3010
Bind each component reference to the corrected type by looking it up
again by name, walking the whole chain so that nested references are
corrected too. '_data', '_vptr' and '_len' are looked up in the class
container of the CLASS component they follow; any other name after a
CLASS component follows an implicit '_data'. A SELECT TYPE selector
that is an element of such a chain was also bound to the class
container instead of its data, because trans_associate_var took the
address of the container as the data pointer.
Assisted-by: Claude Opus 5.5
PR fortran/126968
gcc/fortran/ChangeLog:
* resolve.cc (gfc_fixup_inferred_type_refs): Look each component
reference up again by name in the corrected derived type and
update both u.c.sym and u.c.component. Walk the whole reference
chain instead of stopping at the first component, looking class
container fields up in the container.
* trans-stmt.cc (trans_associate_var): Do not use the address of
a class container as the data of a scalar CLASS selector.
gcc/testsuite/ChangeLog:
* gfortran.dg/associate_89.f90: New test.
* gfortran.dg/associate_91.f90: New test.
---
gcc/fortran/resolve.cc | 48 ++++++++----
gcc/fortran/trans-stmt.cc | 4 +-
gcc/testsuite/gfortran.dg/associate_89.f90 | 56 ++++++++++++++
gcc/testsuite/gfortran.dg/associate_91.f90 | 89 ++++++++++++++++++++++
4 files changed, 183 insertions(+), 14 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/associate_89.f90
create mode 100644 gcc/testsuite/gfortran.dg/associate_91.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index a37a5024ecc..b720e1cc26f 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -7007,7 +7007,7 @@ void
gfc_fixup_inferred_type_refs (gfc_expr *e)
{
gfc_ref *ref, *new_ref;
- gfc_symbol *sym, *derived;
+ gfc_symbol *sym, *dt;
gfc_expr *target;
sym = e->symtree->n.sym;
@@ -7081,9 +7081,6 @@ gfc_fixup_inferred_type_refs (gfc_expr *e)
return;
}
- derived = sym->ts.type == BT_CLASS ? CLASS_DATA (sym)->ts.u.derived
- : sym->ts.u.derived;
-
/* Ensure that class symbols have an array spec and ensure that there
is a _data field reference following class type references. */
if (sym->ts.type == BT_CLASS
@@ -7108,17 +7105,42 @@ gfc_fixup_inferred_type_refs (gfc_expr *e)
}
}
- /* Proceed as far as the first component reference and ensure that the
- correct derived type is being used. */
+ /* The type used to build the component references at parse time was only
+ a guess, so they can point into a different derived type that happens
+ to have a component of the same name. Bind each one by name to the
+ corrected type. */
+ dt = sym->ts.u.derived;
for (ref = e->ref; ref; ref = ref->next)
- if (ref->type == REF_COMPONENT)
- {
- if (ref->u.c.component->name[0] != '_')
- ref->u.c.sym = derived;
- else
- ref->u.c.sym = sym->ts.u.derived;
+ {
+ gfc_component *c;
+
+ if (ref->type != REF_COMPONENT)
+ continue;
+
+ if (!dt)
break;
- }
+
+ /* Only '_data', '_vptr' and '_len' are looked up in a class container;
+ any other name follows an implicit '_data'. */
+ if (dt->attr.is_class && ref->u.c.component->name[0] != '_')
+ dt = dt->components->ts.u.derived;
+
+ c = gfc_find_component (dt, ref->u.c.component->name, true, true, NULL);
+ if (!c)
+ {
+ gfc_error ("%qs at %L is not a member of the %qs structure",
+ ref->u.c.component->name, &e->where, dt->name);
+ return;
+ }
+
+ ref->u.c.sym = dt;
+ ref->u.c.component = c;
+
+ if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
+ dt = c->ts.u.derived;
+ else
+ dt = NULL;
+ }
/* Verify that the type inference mechanism has not introduced a spurious
array reference. This can happen with an associate name, whose selector
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 83150e75236..6eeb1880604 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2372,7 +2372,9 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
ctree = gfc_create_var (dtmp, "class");
if (IS_INFERRED_TYPE (e)
- && !GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)))
+ && !GFC_CLASS_TYPE_P (TREE_TYPE (se.expr))
+ && !(POINTER_TYPE_P (TREE_TYPE (se.expr))
+ && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_TYPE (se.expr)))))
stmp = se.expr;
else
stmp = gfc_class_data_get (ctmp);
diff --git a/gcc/testsuite/gfortran.dg/associate_89.f90 b/gcc/testsuite/gfortran.dg/associate_89.f90
new file mode 100644
index 00000000000..75a48b63e30
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_89.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+! PR fortran/126968
+! ICE in gfc_conv_component_ref when the type of an associate name, whose
+! selector is a function that has not yet been parsed, is guessed wrongly.
+! The guess is the first accessible type with a component of the right name,
+! so 'wrong_t' is picked and has to be corrected during resolution.
+!
+module m
+ type :: wrong_t
+ integer :: x = 1
+ integer :: pad = 0
+ end type
+ type :: right_t
+ real :: junk = 0.0
+ real :: x = 2.5
+ end type
+ type :: outer_t
+ type(right_t) :: c
+ end type
+end module
+
+program p
+ use m
+ implicit none
+ real :: r, ra(3)
+
+ associate (q => scalar_fcn ())
+ r = q%x
+ end associate
+ if (abs (r - 2.5) > 1.0e-6) stop 1
+
+ associate (q => array_fcn ())
+ ra = q(:)%x
+ end associate
+ if (any (abs (ra - 2.5) > 1.0e-6)) stop 2
+
+ associate (q => nested_fcn ())
+ r = q%c%x
+ end associate
+ if (abs (r - 2.5) > 1.0e-6) stop 3
+
+contains
+
+ function scalar_fcn () result (y)
+ type(right_t) :: y
+ end function
+
+ function array_fcn () result (y)
+ type(right_t) :: y(3)
+ end function
+
+ function nested_fcn () result (y)
+ type(outer_t) :: y
+ end function
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/associate_91.f90 b/gcc/testsuite/gfortran.dg/associate_91.f90
new file mode 100644
index 00000000000..09676f0b559
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_91.f90
@@ -0,0 +1,89 @@
+! { dg-do run }
+! PR 126968
+! Component references through more than one CLASS component of an
+! associate name whose selector is a function that has not yet been parsed.
+! The parse-time guess 'wrong_t' has the same chain of component names, so
+! every reference must be rebound, including the '_data' and '_vptr' ones
+! of the inner CLASS component. The SELECT TYPE temporary bound to an
+! element of such a chain pointed at the class container.
+!
+module m
+ implicit none
+ type :: w2_t
+ integer :: bar = 1
+ integer :: extra = 1
+ end type
+ type :: w1_t
+ type(w2_t) :: b(2)
+ end type
+ type :: wrong_t
+ type(w1_t) :: a(2)
+ end type
+ type :: c2_t
+ real :: junk = 0.0
+ real :: bar = 2.5
+ end type
+ type, extends(c2_t) :: c2e_t
+ integer :: extra = 9
+ end type
+ type :: c1_t
+ class(c2_t), allocatable :: b(:)
+ end type
+ type :: outer_t
+ class(c1_t), allocatable :: a(:)
+ end type
+contains
+ subroutine chk (x, n)
+ class(c2_t), intent(in) :: x(:)
+ integer :: n
+ if (size (x) /= 2) stop n
+ select type (x)
+ type is (c2e_t)
+ if (any (x%extra /= 9)) stop n + 1
+ class default
+ stop n + 2
+ end select
+ end subroutine
+ subroutine chk1 (x, n)
+ class(c2_t), intent(in) :: x
+ integer :: n
+ select type (x)
+ type is (c2e_t)
+ if (x%extra /= 9) stop n
+ class default
+ stop n + 1
+ end select
+ end subroutine
+end module
+
+program p
+ use m
+ implicit none
+ real :: r, ra(2)
+
+ associate (q => f ())
+ r = q%a(2)%b(1)%bar
+ ra = q%a(2)%b(:)%bar
+ call chk (q%a(2)%b, 10)
+ call chk1 (q%a(2)%b(2), 20)
+ if (.not. same_type_as (q%a(1)%b, c2e_t ())) stop 30
+ if (size (q%a(2)%b) /= 2) stop 31
+ select type (z => q%a(2)%b(1))
+ type is (c2e_t)
+ if (z%extra /= 9) stop 32
+ class default
+ stop 33
+ end select
+ end associate
+ if (abs (r - 2.5) > 1.0e-6) stop 1
+ if (any (abs (ra - 2.5) > 1.0e-6)) stop 2
+contains
+ function f () result (y)
+ type(outer_t) :: y
+ integer :: i
+ allocate (c1_t :: y%a(2))
+ do i = 1, 2
+ allocate (c2e_t :: y%a(i)%b(2))
+ end do
+ end function
+end program
--
2.56.0
