https://gcc.gnu.org/g:36ca07f0a95c00cc985fc06e46df4028e6f2b77e
commit r14-10387-g36ca07f0a95c00cc985fc06e46df4028e6f2b77e
Author: Harald Anlauf <anl...@gmx.de>
Date: Tue Jul 2 21:26:05 2024 +0200
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.
(cherry picked from commit 7b7f203472d07a05d959a29638c7c95d98bf0c1c)
Diff:
---
gcc/fortran/trans-stmt.cc | 18 ++++++++++++----
gcc/testsuite/gfortran.dg/associate_69.f90 | 33 ++++++++++++++++++++++++++++++
2 files changed, 47 insertions(+), 4 deletions(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 1fd75c6a37c..59237b8cdfb 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));
}
diff --git a/gcc/testsuite/gfortran.dg/associate_69.f90
b/gcc/testsuite/gfortran.dg/associate_69.f90
new file mode 100644
index 00000000000..28f488bb274
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_69.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-Og -Wuninitialized -Wmaybe-uninitialized
-fdump-tree-optimized" }
+!
+! PR fortran/115700 - Bogus warning for associate with assumed-length
character array
+!
+subroutine mvce(x)
+ implicit none
+ character(len=*), dimension(:), intent(in) :: x
+
+ associate (tmp1 => x)
+ if (len (tmp1) /= len (x)) stop 1
+ end associate
+
+ associate (tmp2 => x(1:))
+ if (len (tmp2) /= len (x)) stop 2
+ end associate
+
+ associate (tmp3 => x(1:)(:))
+ if (len (tmp3) /= len (x)) stop 3
+ end associate
+
+! The following associate blocks still produce bogus warnings:
+
+! associate (tmp4 => x(:)(1:))
+! if (len (tmp4) /= len (x)) stop 4
+! end associate
+!
+! associate (tmp5 => x(1:)(1:))
+! if (len (tmp5) /= len (x)) stop 5
+! end associate
+end
+
+! { dg-final { scan-tree-dump-not " \\.tmp" "optimized" } }
