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.

4 files changed, 114 insertions, 0 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1fac183..f243bd1 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4885,6 +4885,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)
@@ -4894,6 +4896,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 0000000..003175a
--- /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 0000000..2b9e8c7
--- /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 0000000..429f129
--- /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
+