diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2024-07-02 21:26:05 +0200 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2024-07-03 19:00:30 +0200 |
| commit | 7b7f203472d07a05d959a29638c7c95d98bf0c1c (patch) | |
| tree | c37547469121919894406143d7d866dd709ff5cd /gcc/fortran | |
| parent | 70f6bc39c4b0e147a816ad1dad583f944616c367 (diff) | |
| download | gcc-7b7f203472d07a05d959a29638c7c95d98bf0c1c.zip gcc-7b7f203472d07a05d959a29638c7c95d98bf0c1c.tar.gz gcc-7b7f203472d07a05d959a29638c7c95d98bf0c1c.tar.bz2 | |
Fortran: fix associate with assumed-length character array [PR115700]
gcc/fortran/ChangeLog:
PR fortran/115700
* trans-stmt.cc (trans_associate_var): When the associate target
is an array-valued character variable, the length is known at entry
of the associate block. Move setting of string length of the
selector to the initialization part of the block.
gcc/testsuite/ChangeLog:
PR fortran/115700
* gfortran.dg/associate_69.f90: New test.
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/trans-stmt.cc | 18 |
1 files changed, 14 insertions, 4 deletions
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 60275e1..703a705 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -1911,6 +1911,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gfc_se se; tree desc; bool cst_array_ctor; + stmtblock_t init; + gfc_init_block (&init); desc = sym->backend_decl; cst_array_ctor = e->expr_type == EXPR_ARRAY @@ -1935,10 +1937,17 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) && !sym->attr.select_type_temporary && sym->ts.u.cl->backend_decl && VAR_P (sym->ts.u.cl->backend_decl) + && se.string_length && se.string_length != sym->ts.u.cl->backend_decl) - gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl, - fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl), - se.string_length)); + { + /* When the target is a variable, its length is already known. */ + tree len = fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl), + se.string_length); + if (e->expr_type == EXPR_VARIABLE) + gfc_add_modify (&init, sym->ts.u.cl->backend_decl, len); + else + gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl, len); + } /* If we didn't already do the pointer assignment, set associate-name descriptor to the one generated for the temporary. */ @@ -1978,7 +1987,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) } /* Done, register stuff as init / cleanup code. */ - gfc_add_init_cleanup (block, gfc_finish_block (&se.pre), + gfc_add_block_to_block (&init, &se.pre); + gfc_add_init_cleanup (block, gfc_finish_block (&init), gfc_finish_block (&se.post)); } |