re PR fortran/69296 ([F03] Problem with associate and vector subscript)

gcc/fortran/ChangeLog:

2016-02-11  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/69296
	* gfortran.h: Added flag to gfc_association_list indicating that
	the rank of an associate variable has been guessed only.
	* parse.c (parse_associate): Set the guess flag mentioned above
	when guessing the rank of an expression.
	* resolve.c (resolve_assoc_var): When the rank has been guessed,
	make sure, that the guess was correct else overwrite with the actual
	rank.
	* trans-stmt.c (trans_associate_var): For subref_array_pointers in
	class objects, take the span from the _data component.

gcc/testsuite/ChangeLog:

2016-02-11  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/69296
	* gfortran.dg/associate_19.f03: New test.
	* gfortran.dg/associate_20.f03: New test.

From-SVN: r233351

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 16a7c3d..77a08c4 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2016-02-11  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+       PR fortran/69296
+       * gfortran.h: Added flag to gfc_association_list indicating that
+       the rank of an associate variable has been guessed only.
+       * parse.c (parse_associate): Set the guess flag mentioned above
+       when guessing the rank of an expression.
+       * resolve.c (resolve_assoc_var): When the rank has been guessed,
+       make sure, that the guess was correct else overwrite with the actual
+       rank.
+       * trans-stmt.c (trans_associate_var): For subref_array_pointers in
+       class objects, take the span from the _data component.
+
 2016-02-07  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/50555

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 8441b8c..33fffd8 100644 (file)
--- 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 (file)
--- 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 e6c3ff9..556c846 100644 (file)
--- 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 (file)
--- 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/ChangeLog b/gcc/testsuite/ChangeLog
index ee68d77..c99f763 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2016-02-11  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+       PR fortran/69296
+       * gfortran.dg/associate_19.f03: New test.
+       * gfortran.dg/associate_20.f03: New test.
+
 2016-02-11  Oleg Endo  <olegendo@gcc.gnu.org>
 
        * gcc.target/sh/pr54089-8.c: Adjust optimization level.

diff --git a/gcc/testsuite/gfortran.dg/associate_19.f03 b/gcc/testsuite/gfortran.dg/associate_19.f03
new file mode 100644 (file)
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 (file)
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