| Message ID | CAGkQGiLaOknkQOpGqixd-P8YuUD0JAHyOjoc72Uaz=w-eaWKQw@mail.gmail.com |
|---|---|
| State | New |
| Headers | show |
| Series | [fortran] PR96495 - [gfortran] Composition of user-defined operators does not copy ALLOCATABLE property of derived type | expand |
Hi Paul, your patch looks fine to me. Ok for trunk. Thanks for the patch. Regards, Andre On Sat, 29 Aug 2020 12:50:20 +0100 Paul Richard Thomas via Fortran <fortran@gcc.gnu.org> wrote: > This patch detects a scalar function result that has allocatable components > and is being used inside a scalarization loop. Before this patch, the > components would be deallocated and nullified within the scalarization loop > and so would cause a segfault on the second cycle of the loop. > > The stored result has to be found by identifying the expression in the loop > ss chain. This is then used for the deallocation of the allocatable > components in the loop post block, which keeps gimple happy and prevents > the segfault. > > Regtests on FC31/x86_64 - OK for master? > > Paul > > This patch fixes PR96495 - frees result components outside loop. > > 2020-29-08 Paul Thomas <pault@gcc.gnu.org> > > gcc/fortran > PR fortran/96495 > * trans-expr.c (gfc_conv_procedure_call): Take the deallocation > of allocatable result components of a scalar result outside the > scalarization loop. Find and use the stored result. > > gcc/testsuite/ > PR fortran/96495 > * gfortran.dg/alloc_comp_result_2.f90 : New test. -- Andre Vehreschild * Email: vehre ad gmx dot de
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 36ff9b5cbc6..a690839f591 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6421,6 +6421,26 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (!finalized && !e->must_finalize) { + bool scalar_res_outside_loop; + scalar_res_outside_loop = e->expr_type == EXPR_FUNCTION + && parm_rank == 0 + && parmse.loop; + + if (scalar_res_outside_loop) + { + /* Go through the ss chain to find the argument and use + the stored value. */ + gfc_ss *tmp_ss = parmse.loop->ss; + for (; tmp_ss; tmp_ss = tmp_ss->next) + if (tmp_ss->info + && tmp_ss->info->expr == e + && tmp_ss->info->data.scalar.value != NULL_TREE) + { + tmp = tmp_ss->info->data.scalar.value; + break; + } + } + if ((e->ts.type == BT_CLASS && GFC_CLASS_TYPE_P (TREE_TYPE (tmp))) || e->ts.type == BT_DERIVED) @@ -6429,7 +6449,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else if (e->ts.type == BT_CLASS) tmp = gfc_deallocate_alloc_comp (CLASS_DATA (e)->ts.u.derived, tmp, parm_rank); - gfc_prepend_expr_to_block (&post, tmp); + + if (scalar_res_outside_loop) + gfc_add_expr_to_block (&parmse.loop->post, tmp); + else + gfc_prepend_expr_to_block (&post, tmp); } }