Hi all,
when Harald attached this PR to the associate meta-bug, I immediately thought:
"Oh, this another one of these missing branches on ts.type == BT_CLASS
thingies". Well, I was wrong.
The issue is that the tbp (the typebound proc info structure) is not resolved
completely when the associate tries to do an early resolve to determine the
rank of the associate variable. When the expression to be resolved for that
contains a compcall, the resolve branches into the incorrect case and emits the
error. My current fix is to wait with generating the error message until the
type has been resolved completely (aka. symbol's resolve_symbol_called is set).
I am not sure, if this is correct, therefore CC'ing Paul, who, to my
knowledge, has more experience in the associate area. But everyone please feel
free to step in!
Regtests ok on x86_64-pc-linux-gnu / F41. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 97eb018d0bc6f86d039d05d9e5d6be114f784c6d Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Mon, 17 Mar 2025 08:24:04 +0100
Subject: [PATCH] Fortran: Fix comp call in associate [PR119272]
PR fortran/119272
gcc/fortran/ChangeLog:
* resolve.cc (resolve_compcall): Postpone error report when
symbol is not resolved yet for component call resolve.
gcc/testsuite/ChangeLog:
* gfortran.dg/associate_74.f90: New test.
---
gcc/fortran/resolve.cc | 5 ++-
gcc/testsuite/gfortran.dg/associate_74.f90 | 47 ++++++++++++++++++++++
2 files changed, 50 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/associate_74.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 34c8210f66a..a8ac42bcd77 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -7351,8 +7351,9 @@ resolve_compcall (gfc_expr* e, const char **name)
/* Check that's really a FUNCTION. */
if (!e->value.compcall.tbp->function)
{
- gfc_error ("%qs at %L should be a FUNCTION",
- e->value.compcall.name, &e->where);
+ if (e->symtree && e->symtree->n.sym->resolve_symbol_called)
+ gfc_error ("%qs at %L should be a FUNCTION", e->value.compcall.name,
+ &e->where);
return false;
}
diff --git a/gcc/testsuite/gfortran.dg/associate_74.f90 b/gcc/testsuite/gfortran.dg/associate_74.f90
new file mode 100644
index 00000000000..057d63534c1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_74.f90
@@ -0,0 +1,47 @@
+!{ dg-do run }
+
+! Check that PR119272 is fixed
+! Contributed by Xing Jing Wei <xingjingwei...@gmail.com>
+
+module pr119272_module
+ type, public :: test_type
+ contains
+ procedure :: scal_function
+ procedure :: arr_function
+ end type test_type
+ contains
+ function scal_function(this) result(smth)
+ class(test_type) :: this
+ integer :: smth
+ smth = 2
+ end function
+ function arr_function(this) result(smth)
+ class(test_type) :: this
+ integer :: smth(9)
+ smth = (/(i, i=1, 9)/)
+ end function
+end module
+
+program pr119272
+ use pr119272_module
+ implicit none
+
+ type(test_type) :: a
+
+ call test_subroutine(a)
+ contains
+ subroutine test_subroutine(a)
+ class(test_type) :: a
+ integer :: i
+ integer,parameter :: temp_int(3) = [ 1, 2, 3]
+ integer,parameter :: identity(9) = (/(i* 5, i= 9, 1, -1)/)
+ associate(temp => temp_int(a%scal_function()))
+ if (temp /= 2) stop 1
+ end associate
+
+ associate(temparr => identity(a%arr_function()))
+ if (any(temparr /= (/(i* 5, i= 9, 1, -1)/))) stop 2
+ end associate
+ end subroutine
+end program
+
--
2.48.1
