https://gcc.gnu.org/g:bb2324769c5a03e275de00416659e624c97f1442
commit r15-2910-gbb2324769c5a03e275de00416659e624c97f1442
Author: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Fri Aug 9 16:19:23 2024 +0200
Fix ICE in build_function_decl [PR116292]
Fix ICE by getting the vtype only when a derived or class type is
prevent. Also take care about the _len component for unlimited
polymorphics.
gcc/fortran/ChangeLog:
PR fortran/116292
* trans-intrinsic.cc (conv_intrinsic_move_alloc): Get the vtab
only for derived types and classes and adjust _len for class
types.
gcc/testsuite/ChangeLog:
* gfortran.dg/move_alloc_19.f90: New test.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 20 ++++++++++++++---
gcc/testsuite/gfortran.dg/move_alloc_19.f90 | 34 +++++++++++++++++++++++++++++
2 files changed, 51 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 150cb9ff963b..84a378ef310c 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -12764,9 +12764,12 @@ conv_intrinsic_move_alloc (gfc_code *code)
gfc_symbol *vtab;
from_tree = from_se.expr;
- vtab = gfc_find_vtab (&from_expr->ts);
- gcc_assert (vtab);
- from_se.expr = gfc_get_symbol_decl (vtab);
+ if (to_expr->ts.type == BT_CLASS)
+ {
+ vtab = gfc_find_vtab (&from_expr->ts);
+ gcc_assert (vtab);
+ from_se.expr = gfc_get_symbol_decl (vtab);
+ }
}
gfc_add_block_to_block (&block, &from_se.pre);
@@ -12811,6 +12814,15 @@ conv_intrinsic_move_alloc (gfc_code *code)
gfc_class_set_vptr (&block, to_se.expr, from_se.expr);
if (from_is_class)
gfc_reset_vptr (&block, from_expr);
+ if (UNLIMITED_POLY (to_expr))
+ {
+ tree to_len = gfc_class_len_get (to_se.class_container);
+ tmp = from_expr->ts.type == BT_CHARACTER && from_se.string_length
+ ? from_se.string_length
+ : size_zero_node;
+ gfc_add_modify_loc (input_location, &block, to_len,
+ fold_convert (TREE_TYPE (to_len), tmp));
+ }
}
if (from_is_scalar)
@@ -12825,6 +12837,8 @@ conv_intrinsic_move_alloc (gfc_code *code)
input_location, &block, from_se.string_length,
build_int_cst (TREE_TYPE (from_se.string_length), 0));
}
+ if (UNLIMITED_POLY (from_expr))
+ gfc_reset_len (&block, from_expr);
return gfc_finish_block (&block);
}
diff --git a/gcc/testsuite/gfortran.dg/move_alloc_19.f90
b/gcc/testsuite/gfortran.dg/move_alloc_19.f90
new file mode 100644
index 000000000000..d23d9809ba11
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/move_alloc_19.f90
@@ -0,0 +1,34 @@
+!{ dg-do run }
+
+! Check PR 116292 is fixed.
+
+! Contributed by Harald Anlauf <anl...@gcc.gnu.org>
+! Sam James <sja...@gcc.gnu.org>
+
+program move_alloc_19
+ character, allocatable :: buffer, dummy, dummy2
+ class(*), allocatable :: poly
+
+ dummy = 'C'
+ dummy2 = 'A'
+ call s()
+ if (allocated (dummy)) stop 1
+ if (allocated (dummy2)) stop 2
+ if (.not. allocated (buffer)) stop 3
+ if (.not. allocated (poly)) stop 4
+ if (buffer /= 'C') stop 5
+ select type (poly)
+ type is (character(*))
+ if (poly /= 'A') stop 6
+ if (len (poly) /= 1) stop 7
+ class default
+ stop 8
+ end select
+ deallocate (poly, buffer)
+contains
+ subroutine s
+ call move_alloc (dummy, buffer)
+ call move_alloc (dummy2, poly)
+ end
+end
+
