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.

diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index d3aeeb89362807c642aac62fd9d6da718dc0e847..7278932b634a399b85790cd938960ed4ad657512 100644 (file)
--- 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 (file)
index 0000000..ce5bf28
--- /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