From b972d95b2cfb0737b5f1ca06cd042356b907c609 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 30 Apr 2011 11:46:31 +0000 Subject: [PATCH] re PR fortran/48746 (Matmul with allocate on assignment) 2011-04-30 Paul Thomas PR fortran/48746 * trans-expr.c (fcncall_realloc_result): Set the bounds and the offset so that the lbounds are one. (gfc_trans_arrayfunc_assign): Add rank to arguments of above. 2011-04-30 Paul Thomas PR fortran/48746 * gfortran.dg/realloc_on_assign_7.f03: Test bounds. From-SVN: r173213 --- gcc/fortran/ChangeLog | 7 +++ gcc/fortran/trans-expr.c | 45 ++++++++++++++++--- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/realloc_on_assign_7.f03 | 3 ++ 4 files changed, 54 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0f7db3a4414..e5b8d31e8b4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-04-30 Paul Thomas + + PR fortran/48746 + * trans-expr.c (fcncall_realloc_result): Set the bounds and the + offset so that the lbounds are one. + (gfc_trans_arrayfunc_assign): Add rank to arguments of above. + 2011-04-29 Paul Thomas PR fortran/48462 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 1582833a054..3dde29837cb 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5539,11 +5539,13 @@ realloc_lhs_loop_for_fcn_call (gfc_se *se, locus *where, gfc_ss **ss, result to the original descriptor. */ static void -fcncall_realloc_result (gfc_se *se) +fcncall_realloc_result (gfc_se *se, int rank) { tree desc; tree res_desc; tree tmp; + tree offset; + int n; /* Use the allocation done by the library. Substitute the lhs descriptor with a copy, whose data field is nulled.*/ @@ -5555,13 +5557,44 @@ fcncall_realloc_result (gfc_se *se) gfc_conv_descriptor_data_set (&se->pre, res_desc, null_pointer_node); se->expr = gfc_build_addr_expr (TREE_TYPE (se->expr), res_desc); - /* Free the lhs after the function call and copy the result data to - it. */ + /* Free the lhs after the function call and copy the result to + the lhs descriptor. */ tmp = gfc_conv_descriptor_data_get (desc); tmp = gfc_call_free (fold_convert (pvoid_type_node, tmp)); gfc_add_expr_to_block (&se->post, tmp); - tmp = gfc_conv_descriptor_data_get (res_desc); - gfc_conv_descriptor_data_set (&se->post, desc, tmp); + gfc_add_modify (&se->post, desc, res_desc); + + offset = gfc_index_zero_node; + tmp = gfc_index_one_node; + /* Now reset the bounds from zero based to unity based. */ + for (n = 0 ; n < rank; n++) + { + /* Accumulate the offset. */ + offset = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + offset, tmp); + /* Now do the bounds. */ + gfc_conv_descriptor_offset_set (&se->post, desc, tmp); + tmp = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]); + tmp = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, + tmp, gfc_index_one_node); + gfc_conv_descriptor_lbound_set (&se->post, desc, + gfc_rank_cst[n], + gfc_index_one_node); + gfc_conv_descriptor_ubound_set (&se->post, desc, + gfc_rank_cst[n], tmp); + + /* The extent for the next contribution to offset. */ + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]), + gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n])); + tmp = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, + tmp, gfc_index_one_node); + } + gfc_conv_descriptor_offset_set (&se->post, desc, offset); } @@ -5631,7 +5664,7 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2) ss->is_alloc_lhs = 1; } else - fcncall_realloc_result (&se); + fcncall_realloc_result (&se, expr1->rank); } gfc_conv_function_expr (&se, expr2); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5eaa00da46a..a4599ca9e56 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-04-30 Paul Thomas + + PR fortran/48746 + * gfortran.dg/realloc_on_assign_7.f03: Test bounds. + 2011-04-30 Jakub Jelinek PR tree-optimization/48809 diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_7.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_7.f03 index ca9a2d943e9..f871d273942 100644 --- a/gcc/testsuite/gfortran.dg/realloc_on_assign_7.f03 +++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_7.f03 @@ -77,5 +77,8 @@ contains call random_number(a) call random_number(b) tmp = matmul(a,b) + if (any (lbound (tmp) .ne. [1,1])) call abort + if (any (ubound (tmp) .ne. [10,12])) call abort end subroutine end program main + -- 2.30.2