diff mbox

[Fortran,committed] PR58652, fix CLASS(*) handling in MOVE_ALLOC

Message ID 525CDD54.4010804@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Oct. 15, 2013, 6:14 a.m. UTC
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
diff mbox

Patch

2013-10-15  Tobias Burnus  <burnus@net-b.de>

	PR fortran/58652
	* trans-intrinsic.c (conv_intrinsic_move_alloc): Fix handling
	of CLASS(*) variables.

2013-10-15  Tobias Burnus  <burnus@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" } }