https://gcc.gnu.org/g:3b80ff5b4222660a39c861a76df1912d8cc293b3
commit r13-9187-g3b80ff5b4222660a39c861a76df1912d8cc293b3
Author: Paul Thomas <pa...@gcc.gnu.org>
Date: Thu Nov 14 13:27:24 2024 +0000
Fortran: Fix ASSOCIATE with assumed-length character array [PR115700]
2024-11-14 Paul Thomas <pa...@gcc.gnu.org>
gcc/fortran
PR fortran/115700
* trans-stmt.cc (trans_associate_var): Update from mainline to
handle substring targets correctly.
gcc/testsuite
PR fortran/115700
* gfortran.dg/associate_69.f90: New test.
Diff:
---
gcc/fortran/trans-stmt.cc | 19 ++++++++++++-----
gcc/testsuite/gfortran.dg/associate_69.f90 | 33 ++++++++++++++++++++++++++++++
2 files changed, 47 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 51d008cacb8d..df4f6f590a41 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1902,6 +1902,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
gfc_add_init_cleanup (block, gfc_finish_block (&se.pre), tmp);
}
+
/* Now all the other kinds of associate variable. */
else if (sym->attr.dimension && !class_target
&& (sym->as->type == AS_DEFERRED || sym->assoc->variable))
@@ -1909,6 +1910,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
@@ -1930,14 +1933,19 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
gfc_conv_expr_descriptor (&se, e);
if (sym->ts.type == BT_CHARACTER
- && sym->ts.deferred
&& !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
@@ -1978,7 +1986,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 000000000000..28f488bb2746
--- /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" } }
