Hi Harald,

thanks for finding the bug so quickly. I took another look and came up with the
attached trivially looking patch, which replaces the old version 1 entirely.

The new v2 version of the patch just makes use of existing code guessing the
type of the associate variable, which once I found it worked surprisingly
well. I have also extended the testcase.

Regtests ok on x86_64-pc-linux-gnu. Ok for mainline?

Regards,
        Andre

On Fri, 13 Dec 2024 14:09:25 +0100
Harald Anlauf <anl...@gmx.de> wrote:

> Hi Andre,
>
> while the patch works with the reduced testcase, it runs into the
> newly added gcc_assert() when trying the original testcase in the PR.
>
> I also wonder if this use of gcc_assert() is a good idea or good style:
>
> +      gcc_assert (gfc_resolve_expr (tgt_expr));
>
> Since gcc_assert is a macro, and its precise definition depends on
> configuration and could possibly be defined to be a no-op, I suggest
> to evaluate arguments with side-effects outside and pass the
> return code to gcc_assert.  (There are also many other ways to handle
> this situation.
>
> Then removing the gcc_assert around the gfc_resolve_expr() avoids
> the ICE, but restores the reported error.
>
> So not OK yet.  Sorry!
>
> Thanks,
> Harald
>
>
> Am 13.12.24 um 10:10 schrieb Andre Vehreschild:
> > Hi all,
> >
> > attached patch fixes an reject-valid of an array constructor in an
> > associate by resolving the array constructor before parsing the
> > associate-block. I am not 100% sure, if that is the right place to do this.
> > But given, that there is already a special casing before the patch, I just
> > propose to do the resolve there.
> >
> > Regstests ok on x86_64-pc-linux-gnu / F41. Ok for mainline ?
> >
> > Regards,
> >     Andre
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>


--
Andre Vehreschild * Email: vehre ad gmx dot de
From eaec9ce7c3241b4a8ca915b5d4987e2c51a98e7c Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Fri, 13 Dec 2024 09:06:11 +0100
Subject: [PATCH] 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.
---
 gcc/fortran/primary.cc                     |  1 +
 gcc/testsuite/gfortran.dg/associate_71.f90 | 39 ++++++++++++++++++++++
 2 files changed, 40 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/associate_71.f90

diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 1db27929eeb..ab49eac450f 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 00000000000..8f67b53180e
--- /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
+
--
2.47.1

Reply via email to