[patch, Fortran, pr69296, v1] [6 Regression] [F03] Problem with associate and vector subscript

[Andre Vehreschild <vehre at gmx dot de>]

Hi all,

the attached patch fixes a regression that was most likely introduced
by one of my former patches, when in an associate() the rank of the
associated variable could not be determined at parse time correctly.
The patch now adds a flag to the association list indicating, that the
rank of the associated variable has been guessed only. In the resolve
phase the rank is corrected when the guess was wrong.

Bootstrapped and regtested ok on x86_64-linux-gnu/F23.

Ok for trunk?

Regards,
	Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 8441b8c..33fffd8 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2344,6 +2344,9 @@ typedef struct gfc_association_list
      for memory handling.  */
   unsigned dangling:1;
 
+  /* True when the rank of the target expression is guessed during parsing.  */
+  unsigned rankguessed:1;
+
   char name[GFC_MAX_SYMBOL_LEN + 1];
   gfc_symtree *st; /* Symtree corresponding to name.  */
   locus where;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 5dcab70..7bce47f 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4098,6 +4098,7 @@ parse_associate (void)
 	  int dim, rank = 0;
 	  if (array_ref)
 	    {
+	      a->rankguessed = 1;
 	      /* Count the dimension, that have a non-scalar extend.  */
 	      for (dim = 0; dim < array_ref->dimen; ++dim)
 		if (array_ref->dimen_type[dim] != DIMEN_ELEMENT
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8752fd4..8fb7a95 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4777,7 +4777,7 @@ fail:
 /* Given a variable expression node, compute the rank of the expression by
    examining the base symbol and any reference structures it may have.  */
 
-static void
+void
 expression_rank (gfc_expr *e)
 {
   gfc_ref *ref;
@@ -8153,16 +8153,19 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
   if (target->rank != 0)
     {
       gfc_array_spec *as;
-      if (sym->ts.type != BT_CLASS && !sym->as)
+      /* The rank may be incorrectly guessed at parsing, therefore make sure
+	 it is corrected now.  */
+      if (sym->ts.type != BT_CLASS && (!sym->as || sym->assoc->rankguessed))
 	{
-	  as = gfc_get_array_spec ();
+	  if (!sym->as)
+	    sym->as = gfc_get_array_spec ();
+	  as = sym->as;
 	  as->rank = target->rank;
 	  as->type = AS_DEFERRED;
 	  as->corank = gfc_get_corank (target);
 	  sym->attr.dimension = 1;
 	  if (as->corank != 0)
 	    sym->attr.codimension = 1;
-	  sym->as = as;
 	}
     }
   else
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 5143c31..cb54499 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1569,7 +1569,9 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
       if (sym->attr.subref_array_pointer)
 	{
 	  gcc_assert (e->expr_type == EXPR_VARIABLE);
-	  tmp = e->symtree->n.sym->backend_decl;
+	  tmp = e->symtree->n.sym->ts.type == BT_CLASS
+	      ? gfc_class_data_get (e->symtree->n.sym->backend_decl)
+	      : e->symtree->n.sym->backend_decl;
 	  tmp = gfc_get_element_type (TREE_TYPE (tmp));
 	  tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
 	  gfc_add_modify (&se.pre, GFC_DECL_SPAN(desc), tmp);
diff --git a/gcc/testsuite/gfortran.dg/associate_19.f03 b/gcc/testsuite/gfortran.dg/associate_19.f03
new file mode 100644
index 0000000..76534c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_19.f03
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! Contributed by mrestelli@gmail.com
+! Adapated by Andre Vehreschild  <vehre@gcc.gnu.org>
+! Test that fix for PR69296 is working.
+
+program p
+ implicit none
+
+ integer :: j, a(2,6), i(3,2)
+
+  a(1,:) = (/ (     j , j=1,6) /)
+  a(2,:) = (/ ( -10*j , j=1,6) /)
+
+  i(:,1) = (/ 1 , 3 , 5 /)
+  i(:,2) = (/ 4 , 5 , 6 /)
+
+  associate( ai => a(:,i(:,1)) )
+    if (any(shape(ai) /= [2, 3])) call abort()
+    if (any(reshape(ai, [6]) /= [1 , -10, 3, -30, 5, -50])) call abort()
+  end associate
+
+end program p
diff --git a/gcc/testsuite/gfortran.dg/associate_20.f03 b/gcc/testsuite/gfortran.dg/associate_20.f03
new file mode 100644
index 0000000..9d420ef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_20.f03
@@ -0,0 +1,31 @@
+! { dg-do run }
+!
+! Contributed by mrestelli@gmail.com
+! Adapated by Andre Vehreschild  <vehre@gcc.gnu.org>
+! Test that fix for PR69296 is working.
+
+program p
+  implicit none
+
+  type foo
+    integer :: i
+  end type
+
+  integer :: j, i(3,2)
+  class(foo), allocatable :: a(:,:)
+
+  allocate (a(2,6))
+
+  a(1,:)%i = (/ (     j , j=1,6) /)
+  a(2,:)%i = (/ ( -10*j , j=1,6) /)
+
+  i(:,1) = (/ 1 , 3 , 5 /)
+  i(:,2) = (/ 4 , 5 , 6 /)
+
+  associate( ai => a(:,i(:,1))%i )
+    if (any(shape(ai) /= [2, 3])) call abort()
+    if (any(reshape(ai, [6]) /= [1 , -10, 3, -30, 5, -50])) call abort()
+  end associate
+
+  deallocate(a)
+end program p

Attachment: pr69296_1.txt
Description: Text document