The reason for the failure was that UNLIMITED_POLY (from_expr) is no
longer true after one did a gfc_add_vptr_component (from_expr);
As vtab is only NULL for unlimited polymorphic [CLASS(*)], I use it now
instead.
Build and regtested on x86-64-gnu-linux.
Committed as Rev. 203586.
Tobias
2013-10-15 Tobias Burnus <bur...@net-b.de>
PR fortran/58652
* trans-intrinsic.c (conv_intrinsic_move_alloc): Fix handling
of CLASS(*) variables.
2013-10-15 Tobias Burnus <bur...@net-b.de>
PR fortran/58652
* gfortran.dg/unlimited_polymorphic_11.f90: New.
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 6b85b5b..7e2bb36 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7624,37 +7624,38 @@ conv_intrinsic_move_alloc (gfc_code *code)
if (UNLIMITED_POLY (from_expr))
vtab = NULL;
else
{
vtab = gfc_find_derived_vtab (from_expr->ts.u.derived);
gcc_assert (vtab);
}
gfc_free_expr (from_expr2);
gfc_init_se (&from_se, NULL);
from_se.want_pointer = 1;
gfc_add_vptr_component (from_expr);
gfc_conv_expr (&from_se, from_expr);
gfc_add_modify_loc (input_location, &block, to_se.expr,
fold_convert (TREE_TYPE (to_se.expr),
from_se.expr));
/* Reset _vptr component to declared type. */
- if (UNLIMITED_POLY (from_expr))
+ if (vtab == NULL)
+ /* Unlimited polymorphic. */
gfc_add_modify_loc (input_location, &block, from_se.expr,
fold_convert (TREE_TYPE (from_se.expr),
null_pointer_node));
else
{
tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
gfc_add_modify_loc (input_location, &block, from_se.expr,
fold_convert (TREE_TYPE (from_se.expr), tmp));
}
}
else
{
if (from_expr->ts.type != BT_DERIVED)
vtab = gfc_find_intrinsic_vtab (&from_expr->ts);
else
vtab = gfc_find_derived_vtab (from_expr->ts.u.derived);
gcc_assert (vtab);
tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
@@ -7680,37 +7681,38 @@ conv_intrinsic_move_alloc (gfc_code *code)
{
if (UNLIMITED_POLY (from_expr))
vtab = NULL;
else
{
vtab = gfc_find_derived_vtab (from_expr->ts.u.derived);
gcc_assert (vtab);
}
from_se.want_pointer = 1;
from_expr2 = gfc_copy_expr (from_expr);
gfc_add_vptr_component (from_expr2);
gfc_conv_expr (&from_se, from_expr2);
gfc_add_modify_loc (input_location, &block, to_se.expr,
fold_convert (TREE_TYPE (to_se.expr),
from_se.expr));
/* Reset _vptr component to declared type. */
- if (UNLIMITED_POLY (from_expr))
+ if (vtab == NULL)
+ /* Unlimited polymorphic. */
gfc_add_modify_loc (input_location, &block, from_se.expr,
fold_convert (TREE_TYPE (from_se.expr),
null_pointer_node));
else
{
tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
gfc_add_modify_loc (input_location, &block, from_se.expr,
fold_convert (TREE_TYPE (from_se.expr), tmp));
}
}
else
{
if (from_expr->ts.type != BT_DERIVED)
vtab = gfc_find_intrinsic_vtab (&from_expr->ts);
else
vtab = gfc_find_derived_vtab (from_expr->ts.u.derived);
gcc_assert (vtab);
tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_11.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_11.f90
new file mode 100644
index 0000000..5b73b32
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_11.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/58652
+!
+! Contributed by Vladimir Fuka
+!
+ class(*),allocatable :: a
+ class(*),allocatable :: c
+ call move_alloc(a,c)
+end
+
+! { dg-final { scan-tree-dump "\\(struct __vtype__STAR \\*\\) c._vptr = \\(struct __vtype__STAR \\*\\) a._vptr;" "original" } }
+! { dg-final { cleanup-tree-dump "original" } }