https://gcc.gnu.org/g:bbb7c53d32ece75ec0c336663ec37df9e63652d3
commit r15-6121-gbbb7c53d32ece75ec0c336663ec37df9e63652d3
Author: Paul Thomas <pa...@gcc.gnu.org>
Date: Wed Dec 11 16:14:05 2024 +0000
Fortran: Add DECL_EXPR for variable length assoc name [PR117901]
2024-12-11 Paul Thomas <pa...@gcc.gnu.org>
gcc/fortran
PR fortran/117901
* trans-stmt.cc (trans_associate_var): A variable character
length array associate name must generate a DECL expression for
the data pointer type.
gcc/testsuite/
PR fortran/117901
* gfortran.dg/pr117901.f90: New test.
Diff:
---
gcc/fortran/trans-stmt.cc | 14 ++++++++++++++
gcc/testsuite/gfortran.dg/pr117901.f90 | 30 ++++++++++++++++++++++++++++++
2 files changed, 44 insertions(+)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 80a9502a8a41..ae3266fb867f 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2065,6 +2065,20 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
|| GFC_ARRAY_TYPE_P (TREE_TYPE (se.expr)));
gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl)));
+ if (sym->ts.type == BT_CHARACTER)
+ {
+ /* Emit a DECL_EXPR for the variable sized array type in so the
+ gimplification of its type sizes works correctly. */
+ tree arraytype;
+ tmp = TREE_TYPE (sym->backend_decl);
+ arraytype = TREE_TYPE (GFC_TYPE_ARRAY_DATAPTR_TYPE (tmp));
+ if (! TYPE_NAME (arraytype))
+ TYPE_NAME (arraytype) = build_decl (UNKNOWN_LOCATION, TYPE_DECL,
+ NULL_TREE, arraytype);
+ gfc_add_expr_to_block (&se.pre, build1 (DECL_EXPR,
+ arraytype, TYPE_NAME (arraytype)));
+ }
+
if (GFC_ARRAY_TYPE_P (TREE_TYPE (se.expr)))
{
if (INDIRECT_REF_P (se.expr))
diff --git a/gcc/testsuite/gfortran.dg/pr117901.f90
b/gcc/testsuite/gfortran.dg/pr117901.f90
new file mode 100644
index 000000000000..b5c3a4fc2779
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr117901.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! { dg-options "-O3" }
+!
+! Test the fix for pr117901, in which the variable length character in
+! the SELECT TYPE construct caused an ICE in make_ssa_name_fn. This is
+! a much reduced testcase, extracted from class_transformational_1.f90.
+! Note that it does not have references to transformational functions
+! of class objects!
+!
+Module class_tests
+contains
+ subroutine class_rebar (arg)
+ class(*), allocatable :: arg(:)
+ call class_bar (arg)
+ end
+ subroutine class_bar(x)
+ class(*), intent(in) :: x(..)
+ integer :: checksum
+ select rank (x)
+ rank (1)
+ select type (x)
+ type is (character(*))
+ checksum = sum(ichar(x(:)(1:1)) + ichar(x(:)(2:2)))
+ print *, checksum
+ end select
+ rank (2)
+ rank (3)
+ end select
+ end
+end module class_tests
