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

[Andre Vehreschild <vehre at gmx dot de>]

PING

On Tue, 2 Feb 2016 18:37:27 +0100
Andre Vehreschild <vehre@gmx.de> wrote:

> 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