diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2011-04-30 11:46:31 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2011-04-30 11:46:31 +0000 |
| commit | b972d95b2cfb0737b5f1ca06cd042356b907c609 (patch) | |
| tree | af36f24ec5a73350b13eb55374d655032eda6563 /gcc/fortran | |
| parent | 46e43d2b55f6d0e54c564b38e73f306f63a66f9e (diff) | |
| download | gcc-b972d95b2cfb0737b5f1ca06cd042356b907c609.zip gcc-b972d95b2cfb0737b5f1ca06cd042356b907c609.tar.gz gcc-b972d95b2cfb0737b5f1ca06cd042356b907c609.tar.bz2 | |
re PR fortran/48746 (Matmul with allocate on assignment)
2011-04-30 Paul Thomas <pault@gcc.gnu.org>
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 <pault@gcc.gnu.org>
PR fortran/48746
* gfortran.dg/realloc_on_assign_7.f03: Test bounds.
From-SVN: r173213
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 45 |
2 files changed, 46 insertions, 6 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0f7db3a..e5b8d31 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-04-30 Paul Thomas <pault@gcc.gnu.org> + + 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 <pault@gcc.gnu.org> PR fortran/48462 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 1582833..3dde298 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); |