This attached patch is one of the followups for the v2 patch and applies after
the v2.
I looked into the possibility of fixing this earlier in the parser. It currently
filters candidates only by the first component name, then drops the list. If it
kept the list and filtered it by the whole chain as it parses (q%cm%c2 needs a
type whose cm has a c2), it would guess right far more often. This would not fix
all cases though. I wonder if some sort two pass approach would help.
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. After a CLASS component, a '_data', '_vptr' or '_len'
reference is looked up in that component's class container, and any
other reference is bound to its declared type, since the '_data'
reference in between can be explicit or implicit. Rebinding stops at
'_vptr' and '_len'.
The array reference after a component was also built from the guessed
component, so it could carry the wrong bounds, or be missing or
spurious when only one of the two components is an array. Make it
agree with the real component: use its array spec, drop or supply a
full array reference, or turn a misparsed section of a scalar
character component back into a substring. Components are now also
checked for PRIVATE access in the real type.
Assisted-by: Claude Opus 5.5
PR fortran/126968
gcc/fortran/ChangeLog:
* resolve.cc (fixup_inferred_component_array_ref): New function.
(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. Look up '_data', '_vptr' and
'_len' in the class container of the preceding CLASS component.
Check component access. Use fixup_inferred_component_array_ref on
the reference after each rebound component.
gcc/testsuite/ChangeLog:
* gfortran.dg/associate_89.f90: New test.
* gfortran.dg/associate_91.f90: New test.
* gfortran.dg/associate_93.f90: New test.
* gfortran.dg/associate_94.f90: New test.
---From 47b26af37da495b9c87c1379b5c1b79d94d9bce8 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Sat, 24 Oct 2026 10:49:03 -0400
Subject: [PATCH v3] 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. After a CLASS component, a '_data', '_vptr' or '_len'
reference is looked up in that component's class container, and any
other reference is bound to its declared type, since the '_data'
reference in between can be explicit or implicit. Rebinding stops at
'_vptr' and '_len'.
The array reference after a component was also built from the guessed
component, so it could carry the wrong bounds, or be missing or
spurious when only one of the two components is an array. Make it
agree with the real component: use its array spec, drop or supply a
full array reference, or turn a misparsed section of a scalar
character component back into a substring. Components are now also
checked for PRIVATE access in the real type.
Assisted-by: Claude Opus 5.5
PR fortran/126968
gcc/fortran/ChangeLog:
* resolve.cc (fixup_inferred_component_array_ref): New function.
(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. Look up '_data', '_vptr' and
'_len' in the class container of the preceding CLASS component.
Check component access. Use fixup_inferred_component_array_ref on
the reference after each rebound component.
gcc/testsuite/ChangeLog:
* gfortran.dg/associate_89.f90: New test.
* gfortran.dg/associate_91.f90: New test.
* gfortran.dg/associate_93.f90: New test.
* gfortran.dg/associate_94.f90: New test.
---
gcc/fortran/resolve.cc | 144 +++++++++++++++++++--
gcc/testsuite/gfortran.dg/associate_89.f90 | 56 ++++++++
gcc/testsuite/gfortran.dg/associate_91.f90 | 78 +++++++++++
gcc/testsuite/gfortran.dg/associate_93.f90 | 84 ++++++++++++
gcc/testsuite/gfortran.dg/associate_94.f90 | 43 ++++++
5 files changed, 394 insertions(+), 11 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/associate_89.f90
create mode 100644 gcc/testsuite/gfortran.dg/associate_91.f90
create mode 100644 gcc/testsuite/gfortran.dg/associate_93.f90
create mode 100644 gcc/testsuite/gfortran.dg/associate_94.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index bbe5f845f66..74564670321 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -6998,6 +6998,63 @@ resolve_procedure:
}
+/* The reference at *LINK follows a reference to component C in the
+ inferred type expression E. Make it agree with the array spec of C. */
+
+static void
+fixup_inferred_component_array_ref (gfc_expr *e, gfc_component *c,
+ gfc_ref **link)
+{
+ gfc_ref *ref = *link, *new_ref;
+ gfc_array_spec *as;
+
+ if (c->ts.type == BT_CLASS)
+ as = CLASS_DATA (c) ? CLASS_DATA (c)->as : NULL;
+ else
+ as = c->as;
+
+ if (ref && ref->type == REF_ARRAY)
+ {
+ if (as)
+ ref->u.ar.as = as;
+ else if (ref->u.ar.type == AR_FULL)
+ {
+ /* Drop the full array ref of a component guessed to be an array. */
+ *link = ref->next;
+ free (ref);
+ }
+ else if (c->ts.type == BT_CHARACTER && ref->u.ar.dimen == 1
+ && ref->u.ar.dimen_type[0] == DIMEN_RANGE
+ && !ref->u.ar.stride[0])
+ {
+ /* A substring misidentified as an array section. */
+ new_ref = gfc_get_ref ();
+ new_ref->type = REF_SUBSTRING;
+ new_ref->u.ss.start = ref->u.ar.start[0];
+ new_ref->u.ss.end = ref->u.ar.end[0];
+ new_ref->u.ss.length = c->ts.u.cl;
+ new_ref->next = ref->next;
+ *link = new_ref;
+ free (ref);
+ }
+ else
+ /* Leave the array ref of a scalar to find_array_spec to diagnose. */
+ ref->u.ar.as = NULL;
+ }
+ else if (as)
+ {
+ /* Supply the full array ref of a component guessed to be scalar. */
+ new_ref = gfc_get_ref ();
+ new_ref->type = REF_ARRAY;
+ new_ref->u.ar.type = AR_FULL;
+ new_ref->u.ar.as = as;
+ new_ref->u.ar.where = e->where;
+ new_ref->next = ref;
+ *link = new_ref;
+ }
+}
+
+
/* 'sym' was initially guessed to be derived type but has been corrected
in resolve_assoc_var to be a class entity or the derived type correcting.
If a class entity it will certainly need the _data reference or the
@@ -7008,7 +7065,7 @@ void
gfc_fixup_inferred_type_refs (gfc_expr *e)
{
gfc_ref *ref, *new_ref;
- gfc_symbol *sym, *derived;
+ gfc_symbol *sym, *derived, *dt, *container;
gfc_expr *target;
sym = e->symtree->n.sym;
@@ -7109,17 +7166,82 @@ 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. */
- 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;
+ /* 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 and fix up the array ref that follows it. */
+ dt = derived;
+ container = sym->ts.type == BT_CLASS ? sym->ts.u.derived : NULL;
+ gfc_component *comp = NULL;
+ gfc_ref **link;
+ for (link = &e->ref; ; link = &(*link)->next)
+ {
+ gfc_component *c;
+
+ ref = *link;
+ if (comp && !(ref && ref->type == REF_COMPONENT
+ && ref->u.c.component->name[0] == '_'))
+ {
+ fixup_inferred_component_array_ref (e, comp, link);
+ comp = NULL;
+ ref = *link;
+ }
+
+ if (!ref)
break;
- }
+
+ if (ref->type != REF_COMPONENT)
+ continue;
+
+ /* '_data', '_vptr' and '_len' are fields of the preceding class
+ container; 'dt' already is the declared type that follows '_data'. */
+ if (ref->u.c.component->name[0] == '_')
+ {
+ if (!container)
+ break;
+ c = gfc_find_component (container, ref->u.c.component->name,
+ true, true, NULL);
+ if (!c)
+ break;
+ ref->u.c.sym = container;
+ ref->u.c.component = c;
+ container = NULL;
+ if (strcmp (c->name, "_data") != 0)
+ break;
+ continue;
+ }
+
+ if (!dt)
+ break;
+
+ c = gfc_find_component (dt, ref->u.c.component->name, false, true, NULL);
+ if (!c)
+ {
+ if (gfc_find_component (dt, ref->u.c.component->name,
+ true, true, NULL))
+ gfc_error ("Component %qs at %L is a PRIVATE component of %qs",
+ ref->u.c.component->name, &e->where, dt->name);
+ else
+ 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;
+ comp = c;
+
+ container = NULL;
+ if (c->ts.type == BT_DERIVED)
+ dt = c->ts.u.derived;
+ else if (c->ts.type == BT_CLASS && CLASS_DATA (c))
+ {
+ container = c->ts.u.derived;
+ dt = CLASS_DATA (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/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..05cecc48a08
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_91.f90
@@ -0,0 +1,78 @@
+! { dg-do run }
+! PR fortran/126968
+! Component references through nested CLASS components of an associate name
+! whose type was guessed wrongly ('wrong_t'). The chain can carry explicit
+! or implicit '_data' references after each CLASS component.
+!
+module m
+ type :: wrong_t
+ integer :: c1 = 1
+ end type
+ type :: leaf_t
+ integer :: bar = 0
+ end type
+ type, extends (leaf_t) :: leaf2_t
+ integer :: baz = 7
+ end type
+ type :: mid_t
+ real :: junk = 0.0
+ class(leaf_t), allocatable :: c2(:)
+ end type
+ type :: outer_t
+ class(mid_t), allocatable :: c1(:)
+ end type
+contains
+ subroutine fill (y)
+ class(outer_t) :: y
+ integer :: k
+ allocate (mid_t :: y%c1(5))
+ do k = 1, 5
+ allocate (leaf2_t :: y%c1(k)%c2(3))
+ y%c1(k)%c2(:)%bar = [10*(k-3)+1, 10*(k-3)+2, 10*(k-3)+3]
+ end do
+ end subroutine
+end module
+
+program p
+ use m
+ implicit none
+ integer :: i, ia(3)
+
+ associate (q => tfcn ())
+ ia = q%c1(4)%c2(:)%bar
+ end associate
+ if (any (ia /= [11, 12, 13])) stop 1
+
+ associate (q => cfcn ())
+ ia = q%c1(4)%c2(:)%bar
+ end associate
+ if (any (ia /= [11, 12, 13])) stop 2
+
+ associate (q => cfcn ())
+ i = q%c1(4)%c2(2)%bar
+ end associate
+ if (i /= 12) stop 3
+
+ associate (q => tfcn ())
+ if (.not. same_type_as (q%c1(4)%c2, leaf2_t ())) stop 4
+ select type (z => q%c1(4)%c2)
+ type is (leaf2_t)
+ if (any (z%baz /= 7)) stop 5
+ class default
+ stop 6
+ end select
+ end associate
+
+contains
+
+ function tfcn () result (y)
+ type(outer_t) :: y
+ call fill (y)
+ end function
+
+ function cfcn () result (y)
+ class(outer_t), allocatable :: y
+ allocate (y)
+ call fill (y)
+ end function
+end program
diff --git a/gcc/testsuite/gfortran.dg/associate_93.f90 b/gcc/testsuite/gfortran.dg/associate_93.f90
new file mode 100644
index 00000000000..aa370752e9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_93.f90
@@ -0,0 +1,84 @@
+! { dg-do run }
+! PR fortran/126968
+! Array references after components of an associate name whose type was
+! guessed wrongly ('g*_t') must follow the array spec of the real component.
+!
+module m
+ type :: leaf_t
+ integer :: bar = 0
+ end type
+ type :: w1_t
+ type(leaf_t) :: b(2)
+ end type
+ type :: g_t
+ type(w1_t) :: a(4)
+ integer :: v(3) = 9
+ character(4) :: s(3) = 'gggg'
+ integer :: m(3) = 9
+ end type
+ type :: c1_t
+ type(leaf_t) :: b(3)
+ end type
+ type :: r_t
+ type(c1_t) :: a(4)
+ integer :: v = 5
+ character(4) :: s = 'abcd'
+ integer :: m(2,2) = reshape ([1, 2, 3, 4], [2, 2])
+ end type
+ type :: g2_t
+ integer :: w = 9
+ character(4) :: t = 'gggg'
+ class(leaf_t), allocatable :: c
+ end type
+ type :: r2_t
+ integer :: w(3) = [1, 2, 3]
+ character(4) :: t(3) = ['aaaa', 'bbbb', 'cccc']
+ class(leaf_t), allocatable :: c(:)
+ end type
+end module
+
+program p
+ use m
+ implicit none
+ integer :: i, ia(3), im(2,2), j(2)
+ character(2) :: c
+ character(4) :: ca(2)
+
+ associate (q => fcn ())
+ ia = q%a(2)%b(:)%bar
+ i = q%v
+ c = q%s(2:3)
+ im = q%m
+ j = q%m(:,2)
+ end associate
+ if (any (ia /= [1, 2, 3])) stop 1
+ if (i /= 5) stop 2
+ if (c /= 'bc') stop 3
+ if (any (im /= reshape ([1, 2, 3, 4], [2, 2]))) stop 4
+ if (any (j /= [3, 4])) stop 5
+
+ associate (q => fcn2 ())
+ ia = q%w
+ ca = q%t(2:3)
+ if (q%t%len /= 4) stop 6
+ if (size (q%c) /= 3) stop 7
+ if (any (q%c%bar /= 7)) stop 8
+ end associate
+ if (any (ia /= [1, 2, 3])) stop 9
+ if (any (ca /= ['bbbb', 'cccc'])) stop 10
+
+contains
+
+ function fcn () result (y)
+ type(r_t) :: y
+ integer :: k
+ do k = 1, 4
+ y%a(k)%b(:)%bar = [1, 2, 3]
+ end do
+ end function
+
+ function fcn2 () result (y)
+ type(r2_t) :: y
+ allocate (y%c(3), source = leaf_t (7))
+ end function
+end program
diff --git a/gcc/testsuite/gfortran.dg/associate_94.f90 b/gcc/testsuite/gfortran.dg/associate_94.f90
new file mode 100644
index 00000000000..6c9341bf050
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_94.f90
@@ -0,0 +1,43 @@
+! { dg-do compile }
+! PR fortran/126968
+! Components of an associate name whose type was guessed wrongly ('g*_t')
+! must be checked against the real type ('r*_t').
+!
+module m
+ type :: g_t
+ integer :: x = 1
+ end type
+ type :: r_t
+ integer, private :: x = 2
+ end type
+ type :: g2_t
+ integer :: v(3) = 9
+ end type
+ type :: r2_t
+ integer :: v = 5
+ end type
+contains
+ function make () result (y)
+ type(r_t) :: y
+ end function
+end module
+
+program p
+ use m
+ implicit none
+ integer :: i
+ associate (q => fcn ())
+ i = q%x ! { dg-error "is a PRIVATE component of" }
+ end associate
+ associate (q => fcn2 ())
+ i = q%v(2) ! { dg-error "Invalid array reference of a non-array" }
+ end associate
+contains
+ function fcn () result (y)
+ type(r_t) :: y
+ y = make ()
+ end function
+ function fcn2 () result (y)
+ type(r2_t) :: y
+ end function
+end program
--
2.56.0
