https://gcc.gnu.org/g:d6d1dedff578726b9d0ed55d0ebc28a9dc5b543c
commit r17-5582-gd6d1dedff578726b9d0ed55d0ebc28a9dc5b543c Author: Jerry DeLisle <[email protected]> Date: Sat Oct 24 10:49:03 2026 -0400 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. Diff: --- gcc/fortran/resolve.cc | 142 ++++++++++++++++++++++++++--- 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, 392 insertions(+), 11 deletions(-) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index ab565345fd41..bd1f36b0e5a0 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -6998,6 +6998,61 @@ 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; + 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. */ + gfc_expr *start = ref->u.ar.start[0]; + gfc_expr *end = ref->u.ar.end[0]; + ref->type = REF_SUBSTRING; + ref->u.ss.start = start; + ref->u.ss.end = end; + ref->u.ss.length = c->ts.u.cl; + } + 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. */ + ref = gfc_get_ref (); + ref->type = REF_ARRAY; + ref->u.ar.type = AR_FULL; + ref->u.ar.as = as; + ref->u.ar.where = e->where; + ref->next = *link; + *link = 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 +7063,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 +7164,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 000000000000..75a48b63e306 --- /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 000000000000..05cecc48a08f --- /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 000000000000..aa370752e9da --- /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 000000000000..6c9341bf050c --- /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
