diff options
| author | Andre Vehreschild <vehre@gcc.gnu.org> | 2024-08-09 16:19:23 +0200 |
|---|---|---|
| committer | Andre Vehreschild <vehre@gcc.gnu.org> | 2024-08-14 09:11:41 +0200 |
| commit | bb2324769c5a03e275de00416659e624c97f1442 (patch) | |
| tree | 9bae941f0686f11d9e355e543d6b60b0970a809d | |
| parent | ca7936f7764116a39d785bb087584805072a3461 (diff) | |
| download | gcc-bb2324769c5a03e275de00416659e624c97f1442.zip gcc-bb2324769c5a03e275de00416659e624c97f1442.tar.gz gcc-bb2324769c5a03e275de00416659e624c97f1442.tar.bz2 | |
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.
| -rw-r--r-- | gcc/fortran/trans-intrinsic.cc | 20 | ||||
| -rw-r--r-- | 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 150cb9f..84a378e 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 0000000..d23d980 --- /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 <anlauf@gcc.gnu.org> +! Sam James <sjames@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 + |