diff options
| author | Andre Vehreschild <vehre@gcc.gnu.org> | 2023-07-27 14:51:34 +0200 |
|---|---|---|
| committer | Andre Vehreschild <vehre@gcc.gnu.org> | 2024-06-07 10:54:03 +0200 |
| commit | c3190756487080a11e819746f00b6e30fd0a0c2e (patch) | |
| tree | 6f8e5456e96bb8e709e448d49c4da1eef3e8dbec /gcc/fortran | |
| parent | a47b1aaa7a76201da7e091d9f8d4488105786274 (diff) | |
| download | gcc-c3190756487080a11e819746f00b6e30fd0a0c2e.zip gcc-c3190756487080a11e819746f00b6e30fd0a0c2e.tar.gz gcc-c3190756487080a11e819746f00b6e30fd0a0c2e.tar.bz2 | |
Add finalizer creation to array constructor for functions of derived type.
PR fortran/90068
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_trans_array_ctor_element): Eval non-
variable expressions once only.
(gfc_trans_array_constructor_value): Add statements of
final block.
(trans_array_constructor): Detect when final block is required.
gcc/testsuite/ChangeLog:
* gfortran.dg/finalize_57.f90: New test.
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/trans-array.cc | 18 |
1 files changed, 17 insertions, 1 deletions
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index eec62c2..cc50b96 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -1885,6 +1885,16 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc, gfc_conv_descriptor_data_get (desc)); tmp = gfc_build_array_ref (tmp, offset, NULL); + if (expr->expr_type == EXPR_FUNCTION && expr->ts.type == BT_DERIVED + && expr->ts.u.derived->attr.alloc_comp) + { + if (!VAR_P (se->expr)) + se->expr = gfc_evaluate_now (se->expr, &se->pre); + gfc_add_expr_to_block (&se->finalblock, + gfc_deallocate_alloc_comp_no_caf ( + expr->ts.u.derived, se->expr, expr->rank, true)); + } + if (expr->ts.type == BT_CHARACTER) { int i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false); @@ -2147,6 +2157,8 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, *poffset = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, *poffset, gfc_index_one_node); + if (finalblock) + gfc_add_block_to_block (finalblock, &se.finalblock); } else { @@ -2795,6 +2807,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) tree neg_len; char *msg; stmtblock_t finalblock; + bool finalize_required; /* Save the old values for nested checking. */ old_first_len = first_len; @@ -2973,8 +2986,11 @@ trans_array_constructor (gfc_ss * ss, locus * where) TREE_USED (offsetvar) = 0; gfc_init_block (&finalblock); + finalize_required = expr->must_finalize; + if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp) + finalize_required = true; gfc_trans_array_constructor_value (&outer_loop->pre, - expr->must_finalize ? &finalblock : NULL, + finalize_required ? &finalblock : NULL, type, desc, c, &offset, &offsetvar, dynamic); |