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 --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 150cb9ff963b6139a6d7ca0f4b2c903e59fecd10..84a378ef310c89e8d9720257d4d1b34f61ee527f 100644 (file)
--- 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 (file)
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
+