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.

diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 2ca2c4744bbc04def9016c3498545861aa5ec584..da517f8394fee400bc63e9338505927370c955b5 100644 (file)
--- 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 (file)
index 0000000..9833476
--- /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