Patchwork [Fortran] PR 51972 - deep copy of class components

login
register
mail settings
Submitter Tobias Burnus
Date Jan. 29, 2012, 6:48 p.m.
Message ID <4F259461.4030304@net-b.de>
Download mbox | patch
Permalink /patch/138459/
State New
Headers show

Comments

Tobias Burnus - Jan. 29, 2012, 6:48 p.m.
Dear all,

for derived type assignment one needs to call "vtab->_copy" for 
polymorphic components. Currently, this does not happen.

The attached draft patch adds support for this, fixing the 
gfortran.dg/class_allocate_12.f90 test case (with STOP removed), 
chapter07/strategy_surrogate_f2003 of Damian's book, and the example of 
comment 3 of the PR - as well as the more extended attached test case.

With this patch, all examples of Damian's book* now compile and run with 
gfortran. The only exception failures with polymorphic coarrays (PR 
51947) and those examples which use unimplemented features 
(deferred-length character components and finalization subroutines). [* 
see http://www.cambridge.org/rouson]

Test case issues:
- I failed to check the result of test3 as couldn't find a way to test 
for the result without hitting PR46356 / PR51754.
- For test4, I get an ICE for the allocate statement, cf. PR 52044.

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias
<http://www.cambridge.org/rouson>
PS: Other patches which have still to be reviewed:
- http://gcc.gnu.org/ml/fortran/2012-01/msg00197.html (default init ICE)
- http://gcc.gnu.org/ml/fortran/2012-01/msg00241.html (ambiguity check fix)
- http://gcc.gnu.org/ml/fortran/2012-01/msg00247.html (FE optimization)
<http://www.cambridge.org/rouson>
Paul Richard Thomas - Jan. 29, 2012, 7:12 p.m.
Dear Tobias,

I cry foul at this point :-)  I have gone gallivanting off to try to
fix really horrid regressions like 52012, whilst you are have fun
doing interesting things.....

Pah!  Good call - OK for trunk

Thanks for the patch.

I notice that you are making good use of recent additions to
trans-expr.c.  Should we do trans-class.c before the release?

Paul

On Sun, Jan 29, 2012 at 7:48 PM, Tobias Burnus <burnus@net-b.de> wrote:
> Dear all,
>
> for derived type assignment one needs to call "vtab->_copy" for polymorphic
> components. Currently, this does not happen.
>
> The attached draft patch adds support for this, fixing the
> gfortran.dg/class_allocate_12.f90 test case (with STOP removed),
> chapter07/strategy_surrogate_f2003 of Damian's book, and the example of
> comment 3 of the PR - as well as the more extended attached test case.
>
> With this patch, all examples of Damian's book* now compile and run with
> gfortran. The only exception failures with polymorphic coarrays (PR 51947)
> and those examples which use unimplemented features (deferred-length
> character components and finalization subroutines). [* see
> http://www.cambridge.org/rouson]
>
> Test case issues:
> - I failed to check the result of test3 as couldn't find a way to test for
> the result without hitting PR46356 / PR51754.
> - For test4, I get an ICE for the allocate statement, cf. PR 52044.
>
> Build and regtested on x86-64-linux.
> OK for the trunk?
>
> Tobias
> <http://www.cambridge.org/rouson>
> PS: Other patches which have still to be reviewed:
> - http://gcc.gnu.org/ml/fortran/2012-01/msg00197.html (default init ICE)
> - http://gcc.gnu.org/ml/fortran/2012-01/msg00241.html (ambiguity check fix)
> - http://gcc.gnu.org/ml/fortran/2012-01/msg00247.html (FE optimization)
> <http://www.cambridge.org/rouson>
Tobias Burnus - Jan. 29, 2012, 8:31 p.m.
Dear Paul,

thanks for the review!

> I cry foul at this point :-)  I have gone gallivanting off to try to
> fix really horrid regressions like 52012, whilst you are have fun
> doing interesting things.....

Well, that way my revenge for not getting a review for my 
default-initializer patch since over a week ... ;-)

I hope that fixing the regression will not be too complicated, it didn't 
look trivial, though. I have to admit that I didn't quite see whether 
gfortran currently does a reallocation or not. In principle it shouldn't 
if the shape doesn't change - especially not if the left-hand side has 
the target attribute.


> I notice that you are making good use of recent additions to
> trans-expr.c.  Should we do trans-class.c before the release?

Maybe. Though, I have to admit, having those macros in trans-expr.c is 
also fine with me.

Tobias
Paul Richard Thomas - Jan. 29, 2012, 8:36 p.m.
Dear Tobias,

> Well, that way my revenge for not getting a review for my
> default-initializer patch since over a week ... ;-)

To be perfectly frank, I was hoping that somebody else would get their
ass in gear :-)

I'll do it.

Paul

Patch

2012-01-29  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51972
	* trans-array.c (structure_alloc_comps): Fix assignment of
	polymorphic components (polymorphic deep copying).

2012-01-29  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51972
	* gfortran.dg/class_allocate_12.f90: Enable disabled test.
	* gfortran.dg/class_48.f90: New.

Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(Revision 183676)
+++ gcc/fortran/trans-array.c	(Arbeitskopie)
@@ -7532,6 +7532,57 @@  structure_alloc_comps (gfc_symbol * der_type, tree
 				  cdecl, NULL_TREE);
 	  dcmp = fold_convert (TREE_TYPE (comp), dcmp);
 
+	  if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
+	    {
+	      tree ftn_tree;
+	      tree size;
+	      tree dst_data;
+	      tree src_data;
+	      tree null_data;
+
+	      dst_data = gfc_class_data_get (dcmp);
+	      src_data = gfc_class_data_get (comp);
+	      size = fold_convert (size_type_node, gfc_vtable_size_get (comp));
+
+	      if (CLASS_DATA (c)->attr.dimension)
+		{
+		  nelems = gfc_conv_descriptor_size (src_data,
+						     CLASS_DATA (c)->as->rank);
+		  src_data = gfc_conv_descriptor_data_get (src_data);
+		  dst_data = gfc_conv_descriptor_data_get (dst_data);
+		}
+	      else
+		nelems = build_int_cst (size_type_node, 1);
+
+	      gfc_init_block (&tmpblock);
+
+	      /* We need to use CALLOC as _copy might try to free allocatable
+		 components of the destination.  */
+	      ftn_tree = builtin_decl_explicit (BUILT_IN_CALLOC);
+              tmp = build_call_expr_loc (input_location, ftn_tree, 2, nelems,
+					 size);
+	      gfc_add_modify (&tmpblock, dst_data,
+			      fold_convert (TREE_TYPE (dst_data), tmp));
+
+	      tmp = gfc_copy_class_to_class (comp, dcmp, nelems);
+	      gfc_add_expr_to_block (&tmpblock, tmp);
+	      tmp = gfc_finish_block (&tmpblock);
+
+	      gfc_init_block (&tmpblock);
+	      gfc_add_modify (&tmpblock, dst_data,
+			      fold_convert (TREE_TYPE (dst_data),
+					    null_pointer_node));
+	      null_data = gfc_finish_block (&tmpblock);
+
+	      null_cond = fold_build2_loc (input_location, NE_EXPR,
+					   boolean_type_node, src_data,
+				           null_pointer_node); 	
+
+	      gfc_add_expr_to_block (&fnblock, build3_v (COND_EXPR, null_cond,
+							 tmp, null_data));
+	      continue;
+	    }
+
 	  if (c->attr.allocatable && !cmp_has_alloc_comps)
 	    {
 	      rank = c->as ? c->as->rank : 0;
Index: gcc/testsuite/gfortran.dg/class_allocate_12.f90
===================================================================
--- gcc/testsuite/gfortran.dg/class_allocate_12.f90	(Revision 183676)
+++ gcc/testsuite/gfortran.dg/class_allocate_12.f90	(Arbeitskopie)
@@ -4,10 +4,6 @@ 
 !
 ! Contributed by Damian Rouson
 !
-! TODO: Remove the STOP line below after fixing
-!       The remaining issue of the PR
-!
-
 module surrogate_module
   type ,abstract :: surrogate
   end type
@@ -78,7 +74,6 @@  contains
       class is (integrand)
         allocate (this_half, source=this)
     end select
-    STOP 'SUCESS!' ! See TODO above
   end subroutine
 end module 
 
Index: gcc/testsuite/gfortran.dg/class_48.f90
===================================================================
--- gcc/testsuite/gfortran.dg/class_48.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/class_48.f90	(Arbeitskopie)
@@ -0,0 +1,110 @@ 
+! { dg-do run }
+!
+! PR fortran/51972
+!
+! Check whether DT assignment with polymorphic components works.
+!
+
+subroutine test1 ()
+  type t
+    integer :: x
+  end type t
+
+  type t2
+    class(t), allocatable :: a
+  end type t2
+
+  type(t2) :: one, two
+
+  one = two
+  if (allocated (one%a)) call abort ()
+
+  allocate (two%a)
+  two%a%x = 7890
+  one = two
+  if (one%a%x /= 7890) call abort ()
+
+  deallocate (two%a)
+  one = two
+  if (allocated (one%a)) call abort ()
+end subroutine test1
+
+subroutine test2 ()
+  type t
+    integer, allocatable :: x(:)
+  end type t
+
+  type t2
+    class(t), allocatable :: a
+  end type t2
+
+  type(t2) :: one, two
+
+  one = two
+  if (allocated (one%a)) call abort ()
+
+  allocate (two%a)
+  one = two
+  if (.not.allocated (one%a)) call abort ()
+  if (allocated (one%a%x)) call abort ()
+
+  allocate (two%a%x(2))
+  two%a%x(:) = 7890
+  one = two
+  if (any (one%a%x /= 7890)) call abort ()
+
+  deallocate (two%a)
+  one = two
+  if (allocated (one%a)) call abort ()
+end subroutine test2
+
+
+subroutine test3 ()
+  type t
+    integer :: x
+  end type t
+
+  type t2
+    class(t), allocatable :: a(:)
+  end type t2
+
+  type(t2) :: one, two
+
+  one = two
+  if (allocated (one%a)) call abort ()
+
+  allocate (two%a(2), source=[t(4), t(6)])
+  one = two
+  if (.not.allocated (one%a)) call abort ()
+! FIXME: Check value
+
+  deallocate (two%a)
+  one = two
+  if (allocated (one%a)) call abort ()
+end subroutine test3
+
+subroutine test4 ()
+  type t
+    integer, allocatable :: x(:)
+  end type t
+
+  type t2
+    class(t), allocatable :: a(:)
+  end type t2
+
+  type(t2) :: one, two
+
+  one = two
+  if (allocated (one%a)) call abort ()
+
+!  allocate (two%a(2)) ! ICE: SEGFAULT
+!  one = two
+!  if (.not. allocated (one%a)) call abort ()
+end subroutine test4
+
+
+call test1 ()
+call test2 ()
+call test3 ()
+call test4 ()
+end