diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 25a2e70cc65e75ccbf7177f9e3011a98f81db6c7..c6a119c73cb4979e0b95f547612898d9ed173c70 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 0000000000000000000000000000000000000000..ce5bf286ee89e0bfcec73e0ac70d75f545c00af8
--- /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