From f82f425b56a1ccf1950c6d0992e7c106558acba0 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 20 May 2018 10:04:46 +0000 Subject: [PATCH] re PR fortran/49636 ([F03] ASSOCIATE construct confused with slightly complicated case) 2018-05-20 Paul Thomas 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-20 Paul Thomas PR fortran/49636 * gfortran.dg/associate_38.f90: New test. From-SVN: r260414 --- gcc/fortran/ChangeLog | 10 ++++++++++ gcc/fortran/trans-array.c | 8 ++++---- gcc/fortran/trans-array.h | 2 ++ gcc/fortran/trans-intrinsic.c | 20 +++++++++++--------- gcc/fortran/trans-stmt.c | 7 ++----- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/associate_38.f90 | 22 ++++++++++++++++++++++ 7 files changed, 56 insertions(+), 18 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/associate_38.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a52932c103f..8e6c933d7c7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2018-05-20 Paul Thomas + + 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-20 Paul Thomas PR fortran/82275 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index cf4b23f4391..7e6cea15c6a 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -817,8 +817,8 @@ is_pointer_array (tree expr) /* Return the span of an array. */ -static tree -get_array_span (tree desc, gfc_expr *expr) +tree +gfc_get_array_span (tree desc, gfc_expr *expr) { tree tmp; @@ -7061,7 +7061,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) subref_array_target, expr); /* ....and set the span field. */ - tmp = get_array_span (desc, expr); + tmp = gfc_get_array_span (desc, expr); gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp); } else if (se->want_pointer) @@ -7334,7 +7334,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) parmtype = TREE_TYPE (parm); /* ....and set the span field. */ - tmp = get_array_span (desc, expr); + tmp = gfc_get_array_span (desc, expr); gfc_conv_descriptor_span_set (&loop.pre, parm, tmp); } else diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index d7c32540a82..5ef86565d8d 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -136,6 +136,8 @@ void gfc_conv_tmp_array_ref (gfc_se * se); /* 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. */ diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 651a97f1d3f..fa019716292 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -4966,7 +4966,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) else { tree ifbody2, elsebody2; - + /* We switch to > or >= depending on the value of the BACK argument. */ cond = gfc_create_var (logical_type_node, "cond"); @@ -7900,15 +7900,17 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) logical_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); - /* A pointer to an array, call library function _gfor_associated. */ - arg1se.want_pointer = 1; - gfc_conv_expr_descriptor (&arg1se, arg1->expr); + /* A pointer to an array, call library function _gfor_associated. */ + arg1se.want_pointer = 1; + gfc_conv_expr_descriptor (&arg1se, arg1->expr); + gfc_add_block_to_block (&se->pre, &arg1se.pre); + gfc_add_block_to_block (&se->post, &arg1se.post); - arg2se.want_pointer = 1; - gfc_conv_expr_descriptor (&arg2se, arg2->expr); - gfc_add_block_to_block (&se->pre, &arg2se.pre); - gfc_add_block_to_block (&se->post, &arg2se.post); - se->expr = build_call_expr_loc (input_location, + arg2se.want_pointer = 1; + gfc_conv_expr_descriptor (&arg2se, arg2->expr); + gfc_add_block_to_block (&se->pre, &arg2se.pre); + gfc_add_block_to_block (&se->post, &arg2se.post); + se->expr = build_call_expr_loc (input_location, gfor_fndecl_associated, 2, arg1se.expr, arg2se.expr); se->expr = convert (logical_type_node, se->expr); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 1952f6cdc08..cc1a4294327 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1735,11 +1735,8 @@ 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->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)); + tmp = gfc_get_array_span (se.expr, e); + gfc_conv_descriptor_span_set (&se.pre, desc, tmp); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 372661152cc..b919b842aa8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-05-20 Paul Thomas + + PR fortran/49636 + * gfortran.dg/associate_38.f90: New test. + 2018-05-20 Paul Thomas PR fortran/82923 diff --git a/gcc/testsuite/gfortran.dg/associate_38.f90 b/gcc/testsuite/gfortran.dg/associate_38.f90 new file mode 100644 index 00000000000..27a6f4b556b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_38.f90 @@ -0,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 +! +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 -- 2.30.2