[PATCH] Fortran: fix TARGET attribute of associating entity in ASSOCIATE [PR112764]

[Harald Anlauf]

Dear all,

the attached simple patch fixes the handling of the TARGET
attribute of an associate variable in an ASSOCIATE construct.

See e.g. F2018:11.1.3.3 for a standard reference.

(Note that the patch does not touch the pointer or allocatable
attributes, as that would lead to several testsuite regressions
and thus needs more work.)

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald


From 023dc4691c73ed594d5c1085f1aab897ca4a7153 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Wed, 29 Nov 2023 21:47:24 +0100
Subject: [PATCH] Fortran: fix TARGET attribute of associating entity in
 ASSOCIATE [PR112764]

The associating entity in an ASSOCIATE construct has the TARGET attribute
if and only if the selector is a variable and has either the TARGET or
POINTER attribute (e.g. F2018:11.1.3.3).

gcc/fortran/ChangeLog:

	PR fortran/112764
	* primary.cc (gfc_variable_attr): Set TARGET attribute of associating
	entity dependent on TARGET or POINTER attribute of selector.

gcc/testsuite/ChangeLog:

	PR fortran/112764
	* gfortran.dg/associate_62.f90: New test.
---
 gcc/fortran/primary.cc                     | 16 ++++++++++++++
 gcc/testsuite/gfortran.dg/associate_62.f90 | 25 ++++++++++++++++++++++
 2 files changed, 41 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/associate_62.f90

diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index d3aeeb89362..7278932b634 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2653,6 +2653,22 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
   if (pointer || attr.proc_pointer)
     target = 1;

+  /* F2018:11.1.3.3: Other attributes of associate names
+     "The associating entity does not have the ALLOCATABLE or POINTER
+     attributes; it has the TARGET attribute if and only if the selector is
+     a variable and has either the TARGET or POINTER attribute."  */
+  if (sym->attr.associate_var && sym->assoc && sym->assoc->target)
+    {
+      if (sym->assoc->target->expr_type == EXPR_VARIABLE)
+	{
+	  symbol_attribute tgt_attr;
+	  tgt_attr = gfc_expr_attr (sym->assoc->target);
+	  target = (tgt_attr.pointer || tgt_attr.target);
+	}
+      else
+	target = 0;
+    }
+
   if (ts != NULL && expr->ts.type == BT_UNKNOWN)
     *ts = sym->ts;

diff --git a/gcc/testsuite/gfortran.dg/associate_62.f90 b/gcc/testsuite/gfortran.dg/associate_62.f90
new file mode 100644
index 00000000000..ce5bf286ee8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_62.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! PR fortran/112764
+! Contributed by martin <ms...@gmx.net>
+
+program assoc_target
+  implicit none
+  integer, dimension(:,:), pointer :: x
+  integer, pointer                 :: j
+  integer, allocatable, target     :: z(:)
+  allocate (x(1:100,1:2), source=1)
+  associate (i1 => x(:,1))
+    j => i1(1)
+    print *, j
+    if (j /= 1) stop 1
+  end associate
+  deallocate (x)
+  allocate (z(3))
+  z(:) = [1,2,3]
+  associate (i2 => z(2:3))
+    j => i2(1)
+    print *, j
+    if (j /= 2) stop 2
+  end associate
+  deallocate (z)
+end program assoc_target
--
2.35.3