diff mbox series

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

Message ID trinity-c5ffe3d0-fba2-4d3b-8bb9-8d4d59343235-1701292583458@3c-app-gmx-bap39
State New
Headers show
Series Fortran: fix TARGET attribute of associating entity in ASSOCIATE [PR112764] | expand

Commit Message

Harald Anlauf Nov. 29, 2023, 9:16 p.m. UTC 
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

Comments

Paul Richard Thomas Nov. 30, 2023, 8:22 a.m. UTC | #1 
Hi Harald,

The original testcase is accepted by the two other brands to which I have
access.

OK for mainline and, I would suggest, 13-branch.

Thanks

Paul


On Wed, 29 Nov 2023 at 21:16, Harald Anlauf <anlauf@gmx.de> wrote:

> 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
>
>
diff mbox series

Patch

From 023dc4691c73ed594d5c1085f1aab897ca4a7153 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@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 <mscfd@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