Hi all,
attached patch fixes a regression introduced by my previous patch on handling
_vptr's more consistently. The patch gets the _vptr only of a derived or
class type now and not of every type.
Regression tested ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
Regards,
Andre
PS. This patch was made with all of my other pending patches on the same
branch. So it may not apply clean to master.
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 4b19d871a3f5a4cdaf0fef6200ddaf51d6c8a8c4 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <ve...@gcc.gnu.org>
Date: Fri, 9 Aug 2024 16:19:23 +0200
Subject: [PATCH] [Fortran] 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.
---
gcc/fortran/trans-intrinsic.cc | 20 ++++++++++--
gcc/testsuite/gfortran.dg/move_alloc_19.f90 | 34 +++++++++++++++++++++
2 files changed, 51 insertions(+), 3 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/move_alloc_19.f90
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 34115c2679b..0ecb0439778 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -12774,9 +12774,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);
@@ -12821,6 +12824,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)
@@ -12835,6 +12847,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 00000000000..d23d9809ba1
--- /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
+
--
2.46.0
