This patch is a straightforward recycling of existing code to replace
an incomplete copy elsewhere.
Bootstraps and regtests on FC27/x86_64 - OK for trunk down to 7-branch?
Paul
2018-05-19 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/49636
* trans-array.c (gfc_get_array_span): Renamed from
'get_array_span'.
(gfc_conv_expr_descriptor): Change references to above.
* trans-array.h : Add prototype for 'gfc_get_array_span'.
* trans-stmt.c (trans_associate_var): If the associate name is
a subref array pointer, use gfc_get_array_span for the span.
2018-05-19 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/49636
* gfortran.dg/associate_38.f90: New test.
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 260392)
--- gcc/fortran/trans-array.c (working copy)
*************** is_pointer_array (tree expr)
*** 817,824 ****
/* Return the span of an array. */
! static tree
! get_array_span (tree desc, gfc_expr *expr)
{
tree tmp;
--- 817,824 ----
/* Return the span of an array. */
! tree
! gfc_get_array_span (tree desc, gfc_expr *expr)
{
tree tmp;
*************** gfc_conv_expr_descriptor (gfc_se *se, gf
*** 7061,7067 ****
subref_array_target, expr);
/* ....and set the span field. */
! tmp = get_array_span (desc, expr);
gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
}
else if (se->want_pointer)
--- 7061,7067 ----
subref_array_target, expr);
/* ....and set the span field. */
! tmp = gfc_get_array_span (desc, expr);
gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
}
else if (se->want_pointer)
*************** gfc_conv_expr_descriptor (gfc_se *se, gf
*** 7334,7340 ****
parmtype = TREE_TYPE (parm);
/* ....and set the span field. */
! tmp = get_array_span (desc, expr);
gfc_conv_descriptor_span_set (&loop.pre, parm, tmp);
}
else
--- 7334,7340 ----
parmtype = TREE_TYPE (parm);
/* ....and set the span field. */
! tmp = gfc_get_array_span (desc, expr);
gfc_conv_descriptor_span_set (&loop.pre, parm, tmp);
}
else
Index: gcc/fortran/trans-array.h
===================================================================
*** gcc/fortran/trans-array.h (revision 260391)
--- gcc/fortran/trans-array.h (working copy)
*************** void gfc_conv_tmp_array_ref (gfc_se * se
*** 136,141 ****
--- 136,143 ----
/* Translate a reference to an array temporary. */
void gfc_conv_tmp_ref (gfc_se *);
+ /* Obtain the span of an array. */
+ tree gfc_get_array_span (tree, gfc_expr *);
/* Evaluate an array expression. */
void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *);
/* Convert an array for passing as an actual function parameter. */
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c (revision 260391)
--- gcc/fortran/trans-stmt.c (working copy)
*************** trans_associate_var (gfc_symbol *sym, gf
*** 1735,1745 ****
if (sym->attr.subref_array_pointer)
{
gcc_assert (e->expr_type == EXPR_VARIABLE);
! 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_conv_descriptor_span_set (&se.pre, desc, tmp);
}
--- 1735,1742 ----
if (sym->attr.subref_array_pointer)
{
gcc_assert (e->expr_type == EXPR_VARIABLE);
! tmp = gfc_get_array_span (se.expr, e);
!
gfc_conv_descriptor_span_set (&se.pre, desc, tmp);
}
Index: gcc/testsuite/gfortran.dg/associate_38.f90
===================================================================
*** gcc/testsuite/gfortran.dg/associate_38.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/associate_38.f90 (working copy)
***************
*** 0 ****
--- 1,22 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR49636 in which the 'span' of 'ty1' was not used
+ ! in the descriptor of 'i'.
+ !
+ ! Contributed by Fred Krogh <fkrogh#g...@mathalacarte.com>
+ !
+ program test
+ type ty1
+ integer :: k
+ integer :: i
+ end type ty1
+ type ty2
+ type(ty1) :: j(3)
+ end type ty2
+
+ type(ty2) t2
+ t2%j(1:3)%i = [ 1, 3, 5 ]
+ associate (i=>t2%j%i)
+ if (any (t2%j(1:3)%i .ne. i(1:3))) stop 1
+ end associate
+ end program test
