diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2020-09-24 11:52:30 +0100 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2020-09-24 11:52:30 +0100 |
| commit | e86a02f87d8a11480c1421ef2dd71b8b5f43d938 (patch) | |
| tree | 87dd382f6a75e535a9fc6570dc85b3dc74b2d83a /gcc/fortran/trans-expr.c | |
| parent | fe28d34079aad7d3bf8d9bfd78d0ba43110b7906 (diff) | |
| download | gcc-e86a02f87d8a11480c1421ef2dd71b8b5f43d938.zip gcc-e86a02f87d8a11480c1421ef2dd71b8b5f43d938.tar.gz gcc-e86a02f87d8a11480c1421ef2dd71b8b5f43d938.tar.bz2 | |
This patch fixes PR96495 - frees result components outside loop.
2020-24-09 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.
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 26 |
1 files changed, 25 insertions, 1 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 36ff9b5..a690839 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); } } |