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 mreste...@gmail.com +! Adapated by Andre Vehreschild <ve...@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 mreste...@gmail.com +! Adapated by Andre Vehreschild <ve...@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
gcc/fortran/ChangeLog: 2016-02-02 Andre Vehreschild <ve...@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-02 Andre Vehreschild <ve...@gcc.gnu.org> * gfortran.dg/associate_19.f03: New test. * gfortran.dg/associate_20.f03: New test.