Hi Paul, hi all,
thanks for the review. Committed as r233351.
Regards,
Andre
On Thu, 11 Feb 2016 13:36:44 +0100
Paul Richard Thomas <[email protected]> wrote:
> Dear Andre,
>
> That's very clever! OK for trunk
>
> Thanks for the patch
>
> Paul
>
> On 11 February 2016 at 13:05, Andre Vehreschild <[email protected]> wrote:
> > PING
> >
> > On Tue, 2 Feb 2016 18:37:27 +0100
> > Andre Vehreschild <[email protected]> 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
>
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 233350)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,16 @@
+2016-02-11 Andre Vehreschild <[email protected]>
+
+ 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 <[email protected]>
PR fortran/50555
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (Revision 233350)
+++ gcc/fortran/gfortran.h (Arbeitskopie)
@@ -2344,6 +2344,9 @@
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;
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c (Revision 233350)
+++ gcc/fortran/parse.c (Arbeitskopie)
@@ -4098,6 +4098,7 @@
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
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (Revision 233350)
+++ gcc/fortran/resolve.c (Arbeitskopie)
@@ -4777,7 +4777,7 @@
/* 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,9 +8153,13 @@
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);
@@ -8162,7 +8166,6 @@
sym->attr.dimension = 1;
if (as->corank != 0)
sym->attr.codimension = 1;
- sym->as = as;
}
}
else
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (Revision 233350)
+++ gcc/fortran/trans-stmt.c (Arbeitskopie)
@@ -1569,7 +1569,9 @@
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);
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 233350)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,9 @@
+2016-02-11 Andre Vehreschild <[email protected]>
+
+ PR fortran/69296
+ * gfortran.dg/associate_19.f03: New test.
+ * gfortran.dg/associate_20.f03: New test.
+
2016-02-11 Oleg Endo <[email protected]>
* gcc.target/sh/pr54089-8.c: Adjust optimization level.
Index: gcc/testsuite/gfortran.dg/associate_19.f03
===================================================================
--- gcc/testsuite/gfortran.dg/associate_19.f03 (nicht existent)
+++ gcc/testsuite/gfortran.dg/associate_19.f03 (Arbeitskopie)
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! Contributed by [email protected]
+! Adapated by Andre Vehreschild <[email protected]>
+! 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
Index: gcc/testsuite/gfortran.dg/associate_20.f03
===================================================================
--- gcc/testsuite/gfortran.dg/associate_20.f03 (nicht existent)
+++ gcc/testsuite/gfortran.dg/associate_20.f03 (Arbeitskopie)
@@ -0,0 +1,31 @@
+! { dg-do run }
+!
+! Contributed by [email protected]
+! Adapated by Andre Vehreschild <[email protected]>
+! 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
