[gcc r10-10108] Fortran: Improve resolution of associate variables. [PR93701].

[Harald Anlauf <anlauf@gcc.gnu.org>]

https://gcc.gnu.org/g:56defe319186a21dc37e50db8d71185bce332506

commit r10-10108-g56defe319186a21dc37e50db8d71185bce332506
Author: Paul Thomas <pault@gcc.gnu.org>
Date:   Thu Jan 7 17:34:49 2021 +0000

    Fortran: Improve resolution of associate variables. [PR93701].
    
    2021-01-07  Paul Thomas  <pault@gcc.gnu.org>
    
    gcc/fortran
            PR fortran/93701
            * resolve.c (find_array_spec): Put static prototype for
            resolve_assoc_var before this function and call for associate
            variables.
    
    gcc/testsuite/
            PR fortran/93701
            * gfortran.dg/associate_54.f90: New test.
            * gfortran.dg/associate_55.f90: New test.
            * gfortran.dg/associate_56.f90: New test.
    
    (cherry picked from commit 85fb1d7d5f44a81a52015d58ebe67765faabfd35)

Diff:
---
 gcc/fortran/resolve.c                      |  9 ++++++++
 gcc/testsuite/gfortran.dg/associate_54.f90 | 34 ++++++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/associate_55.f90 | 35 +++++++++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/associate_56.f90 | 36 ++++++++++++++++++++++++++++++
 4 files changed, 114 insertions(+)

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7ca5f44f419..3bfee676139 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4858,6 +4858,8 @@ gfc_resolve_dim_arg (gfc_expr *dim)
    base symbol.  We traverse the list of reference structures, setting
    the stored reference to references.  Component references can
    provide an additional array specification.  */
+static void
+resolve_assoc_var (gfc_symbol* sym, bool resolve_target);
 
 static void
 find_array_spec (gfc_expr *e)
@@ -4867,6 +4869,13 @@ find_array_spec (gfc_expr *e)
   gfc_ref *ref;
   bool class_as = false;
 
+  if (e->symtree->n.sym->assoc)
+    {
+      if (e->symtree->n.sym->assoc->target)
+	gfc_resolve_expr (e->symtree->n.sym->assoc->target);
+      resolve_assoc_var (e->symtree->n.sym, false);
+    }
+
   if (e->symtree->n.sym->ts.type == BT_CLASS)
     {
       as = CLASS_DATA (e->symtree->n.sym)->as;
diff --git a/gcc/testsuite/gfortran.dg/associate_54.f90 b/gcc/testsuite/gfortran.dg/associate_54.f90
new file mode 100644
index 00000000000..003175a47fd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_54.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+!
+! Test the fix for PR93701.
+!
+! Contributed by Simon Brass  <simon.brass@desy.de>
+!
+module test
+  implicit none
+
+  integer, parameter :: N_STATE = 1, &
+       TEST_STATE = 1
+
+  type :: test_t
+     integer, dimension(:), allocatable :: state
+  end type test_t
+
+contains
+
+  subroutine test_allocate (obj)
+    class(test_t), intent(out) :: obj
+    allocate (obj%state(N_STATE))
+  end subroutine test_allocate
+
+  subroutine test_alter_state1 (obj, a)
+    class(test_t), intent(inout) :: obj
+    integer, intent(in) :: a
+    associate (state => obj%state(TEST_STATES)) ! { dg-error "is used as array" }
+!      state = a
+      state(TEST_STATE) = a
+    end associate
+  end subroutine test_alter_state1
+
+end module test
+
diff --git a/gcc/testsuite/gfortran.dg/associate_55.f90 b/gcc/testsuite/gfortran.dg/associate_55.f90
new file mode 100644
index 00000000000..2b9e8c727f9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_55.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! Test the fix for PR93701.
+!
+! Contributed by Simon Brass  <simon.brass@desy.de>
+!
+module test
+  implicit none
+
+  integer, parameter :: N_STATE = 1, &
+       TEST_STATE = 1
+
+  type :: test_t
+     integer, dimension(:), allocatable :: state
+  end type test_t
+
+contains
+
+  subroutine test_allocate (obj)
+    class(test_t), intent(out) :: obj
+    allocate (obj%state(N_STATE))
+  end subroutine test_allocate
+
+
+  subroutine test_alter_state2 (obj, a)
+    class(test_t), intent(inout) :: obj
+    integer, intent(in) :: a
+    associate (state => obj%state(TEST_STATES)) ! { dg-error "no IMPLICIT type" }
+      state = a                                 ! { dg-error "vector-indexed target" }
+!      state(TEST_STATE) = a
+    end associate
+  end subroutine test_alter_state2
+
+end module test
+
diff --git a/gcc/testsuite/gfortran.dg/associate_56.f90 b/gcc/testsuite/gfortran.dg/associate_56.f90
new file mode 100644
index 00000000000..429f129da6e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_56.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! Test the fix for PR93701.
+!
+! Contributed by Simon Brass  <simon.brass@desy.de>
+!
+module test
+  implicit none
+
+  integer, parameter :: N_STATE = 1, &
+       TEST_STATE = 1
+
+  type :: test_t
+     integer, dimension(:), allocatable :: state
+  end type test_t
+
+contains
+
+  subroutine test_allocate (obj)
+    class(test_t), intent(out) :: obj
+    allocate (obj%state(N_STATE))
+  end subroutine test_allocate
+
+
+  subroutine test_alter_state2 (obj, a)
+    class(test_t), intent(inout) :: obj
+    integer, intent(in) :: a
+    integer, dimension(2) :: TEST_STATES = [1,2]
+    associate (state => obj%state(TEST_STATES))
+      state = a                                 ! { dg-error "vector-indexed target" }
+      state(TEST_STATE) = a                     ! { dg-error "vector-indexed target" }
+    end associate
+  end subroutine test_alter_state2
+
+end module test
+