https://gcc.gnu.org/g:9a13dc48a3ac3282aaf9a77516b4f02faa60e393
commit r15-8297-g9a13dc48a3ac3282aaf9a77516b4f02faa60e393
Author: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Mon Mar 17 08:24:04 2025 +0100
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.
Diff:
---
gcc/fortran/resolve.cc | 5 ++--
gcc/testsuite/gfortran.dg/associate_74.f90 | 47 ++++++++++++++++++++++++++++++
2 files changed, 50 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index ddd982702309..b9c469a5beca 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 000000000000..057d63534c1c
--- /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
+
