https://gcc.gnu.org/g:1386faee4600160c9a0f85f683d6c1c65d282099
commit r16-9104-g1386faee4600160c9a0f85f683d6c1c65d282099 Author: Jerry DeLisle <[email protected]> Date: Sat Jun 6 09:47:59 2026 -0700 fortran: inferred-type ASSOCIATE name giving spurious "Expected argument list" In gfc_match_varspec, when parsing component references on an inferred-type ASSOCIATE name, the parser incorrectly matched the component name as a type-bound procedure . For inferred-type ASSOCIATE names the parse-time candidate type may differ from the final resolved type. If gfc_find_component fails with the default access check, retry with noaccess=true; the resolution pass will substitute the correct type. Assisted-by: Claude Sonnet 4.6 PR fortran/125531 gcc/fortran/ChangeLog: * primary.cc (gfc_match_varspec): Before erroring on a zero-argument COMPCALL, check for a same-named data component and fall back to the data-component path. For inferred-type ASSOCIATE names, retry gfc_find_component with noaccess=true when the normal search fails. gcc/testsuite/ChangeLog: * gfortran.dg/associate_infer_program_type.f90: New test. (cherry picked from commit 1572da928e4f067cb45c511156899bda1d73e593) Diff: --- gcc/fortran/primary.cc | 27 ++++++++++++++- .../gfortran.dg/associate_infer_program_type.f90 | 39 ++++++++++++++++++++++ 2 files changed, 65 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 2ca2c4744bbc..da517f8394fe 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2715,6 +2715,19 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, primary->value.compcall.actual = NULL; else { + /* Before erroring, check whether there is also a data + component with this name. Use noaccess=true so + that private components are also found. */ + if (sym && gfc_find_component (sym, name, true, true, NULL)) + { + /* Restore expr to EXPR_VARIABLE and let the data + component path below handle it. */ + primary->expr_type = EXPR_VARIABLE; + gfc_free_actual_arglist (primary->value.compcall.actual); + primary->value.compcall.actual = NULL; + tbp = NULL; + goto try_data_component; + } gfc_error ("Expected argument list at %C"); return MATCH_ERROR; } @@ -2723,10 +2736,22 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, break; } + try_data_component: + previous = component; if (!inquiry && !intrinsic) - component = gfc_find_component (sym, name, false, false, &tmp); + { + component = gfc_find_component (sym, name, false, false, &tmp); + /* For inferred-type ASSOCIATE names the parse-time candidate type + may not be the final type; a private component in the candidate + type may correspond to a public component in the correct type. + Accept it tentatively so that resolution can fix up the type. */ + if (!component && !tbp + && primary->symtree && primary->symtree->n.sym->assoc + && primary->symtree->n.sym->assoc->inferred_type) + component = gfc_find_component (sym, name, true, false, &tmp); + } else component = NULL; diff --git a/gcc/testsuite/gfortran.dg/associate_infer_program_type.f90 b/gcc/testsuite/gfortran.dg/associate_infer_program_type.f90 new file mode 100644 index 000000000000..9833476a2a71 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_infer_program_type.f90 @@ -0,0 +1,39 @@ +! { dg-do compile } +! { dg-options "" } +! +! PR fortran/125531 +! ASSOCIATE with a contained-function selector, using the result's data +! components as arguments to another function (also from CONTAINS), where +! the result type is defined in program scope. This used to fail with +! "Invalid association target". +! +program test + implicit none + + type :: args_t + integer :: order_ = 4 + integer :: cells_ = 20 + double precision :: x_min_ = 0d0, x_max_ = 1d0 + end type + + associate(args => get_args()) + associate(result => compute(args%order_, args%cells_)) + print *, result + end associate + end associate + +contains + + function get_args() result(r) + type(args_t) :: r + r%order_ = 2 + r%cells_ = 10 + end function + + function compute(order, cells) result(r) + integer, intent(in) :: order, cells + integer :: r + r = order * cells + end function + +end program
