https://gcc.gnu.org/g:9684e70952ac159ce0b838533ce4e9c98474e1a8
commit r15-6292-g9684e70952ac159ce0b838533ce4e9c98474e1a8
Author: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Fri Dec 13 09:06:11 2024 +0100
Fortran: Fix associate with derived type array construtor [PR117347]
gcc/fortran/ChangeLog:
PR fortran/117347
* primary.cc (gfc_match_varspec): Add array constructors for
guessing their type like with unresolved function calls.
gcc/testsuite/ChangeLog:
* gfortran.dg/associate_71.f90: New test.
Diff:
---
gcc/fortran/primary.cc | 1 +
gcc/testsuite/gfortran.dg/associate_71.f90 | 39 ++++++++++++++++++++++++++++++
2 files changed, 40 insertions(+)
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 1db27929eebd..ab49eac450f6 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2423,6 +2423,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag,
bool sub_flag,
component name 're' or 'im' could be found. */
if (tgt_expr
&& (tgt_expr->expr_type == EXPR_FUNCTION
+ || tgt_expr->expr_type == EXPR_ARRAY
|| (!resolved && tgt_expr->expr_type == EXPR_OP))
&& (sym->ts.type == BT_UNKNOWN
|| (inferred_type && sym->ts.type != BT_COMPLEX))
diff --git a/gcc/testsuite/gfortran.dg/associate_71.f90
b/gcc/testsuite/gfortran.dg/associate_71.f90
new file mode 100644
index 000000000000..8f67b53180e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_71.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! Check that pr117347 is fixed.
+! Contributed by Ivan Pribec <ivan.pri...@gmail.com>
+
+program pr117347
+ implicit none
+
+ type :: point
+ real :: x = 42.
+ end type point
+
+ type(point) :: mypoint
+ real :: pi(1)
+ associate (points => mypoint )
+ pi(:) = points% x
+ end associate
+ if (any(pi /= 42)) stop 1
+ associate (points => (mypoint))
+ pi(:) = points% x
+ end associate
+ if (any(pi /= 42)) stop 2
+ associate (points => [mypoint])
+ pi(:) = points% x
+ end associate
+ if (any(pi /= 42)) stop 3
+ associate (points => [rpoint()])
+ pi(:) = points% x
+ end associate
+ if (any(pi /= 35)) stop 4
+
+contains
+
+ function rpoint() result(r)
+ type(point) :: r
+ r%x = 35
+ end function
+end program
+
