diff mbox

[fortran,5] Bakport Andre's r222477 deep copy fix for PR67818

Message ID 56112974.9010607@sfr.fr
State New
Headers show

Commit Message

Mikael Morin Oct. 4, 2015, 1:28 p.m. UTC
Hello,

my recent PR67721 patch [1] introduced a regression [2] on the 5 branch.
[1] https://gcc.gnu.org/ml/gcc-patches/2015-09/msg02048.html
[2] https://gcc.gnu.org/bugzilla/show_bug.cgi?id=67818

The patch [1] introduces more deep copies, but deep copies have been 
somewhat broken, until Andre fixed them on trunk [3][4].
[3] https://gcc.gnu.org/ml/fortran/2015-04/msg00110.html
[4] https://gcc.gnu.org/r222477

I'm proposing to backport that fix on the 5 branch.
It looks reasonable to me (albeit bigger than I would like), has no 
known regression so far, and Paul even proposed it for backport at the 
time he reviewed it [5].
[5] https://gcc.gnu.org/ml/fortran/2015-04/msg00101.html

The backported patch exhibits no regression (in either check-fortran or 
check-target-libgomp) on x86_64-linux, and it fixes the 
check-target-libgomp regression. The latter has been confirmed by 
Dominique and H.J.Lu in the PR comments [6][7]
[6] https://gcc.gnu.org/bugzilla/show_bug.cgi?id=67818#c7
[7] https://gcc.gnu.org/bugzilla/show_bug.cgi?id=67818#c8

No new test, the failure is already in the libgomp testsuite.
OK for the 5 branch?

Mikael

Comments

Andre Vehreschild Oct. 15, 2015, 10:18 a.m. UTC | #1
Hi Mikael, hi all,

I have checked that the patch (my initial one for pr59678) does compile
and test fine. Given that the patch lives in trunk-6 for quite some
time now, without any major complaints, I approve to commit to gcc-5.
Given the patch was reviewed by Paul already, I don't see any reason
why it should need a second review for gcc-5.

Regards,
	Andre

PS: Note, I don't have reviewer status.

On Sun, 4 Oct 2015 15:28:20 +0200
Mikael Morin <mikael.morin@sfr.fr> wrote:

> Hello,
> 
> my recent PR67721 patch [1] introduced a regression [2] on the 5 branch.
> [1] https://gcc.gnu.org/ml/gcc-patches/2015-09/msg02048.html
> [2] https://gcc.gnu.org/bugzilla/show_bug.cgi?id=67818
> 
> The patch [1] introduces more deep copies, but deep copies have been 
> somewhat broken, until Andre fixed them on trunk [3][4].
> [3] https://gcc.gnu.org/ml/fortran/2015-04/msg00110.html
> [4] https://gcc.gnu.org/r222477
> 
> I'm proposing to backport that fix on the 5 branch.
> It looks reasonable to me (albeit bigger than I would like), has no 
> known regression so far, and Paul even proposed it for backport at the 
> time he reviewed it [5].
> [5] https://gcc.gnu.org/ml/fortran/2015-04/msg00101.html
> 
> The backported patch exhibits no regression (in either check-fortran or 
> check-target-libgomp) on x86_64-linux, and it fixes the 
> check-target-libgomp regression. The latter has been confirmed by 
> Dominique and H.J.Lu in the PR comments [6][7]
> [6] https://gcc.gnu.org/bugzilla/show_bug.cgi?id=67818#c7
> [7] https://gcc.gnu.org/bugzilla/show_bug.cgi?id=67818#c8
> 
> No new test, the failure is already in the libgomp testsuite.
> OK for the 5 branch?
> 
> Mikael
> 
> 
> 
>
Steve Kargl Oct. 15, 2015, 1:59 p.m. UTC | #2
On Thu, Oct 15, 2015 at 12:18:12PM +0200, Andre Vehreschild wrote:
> 
> Regards,
> 	Andre
> 
> PS: Note, I don't have reviewer status.
> 

Given your contributions to gfortran and the fact that
you probably understand portions of the (de)allocation
code better than anyone, I suspect that your opinion
on any patch would be quite welcomed.  In other words,
consider youself a reviewer for patches in an area 
of the compiler that you are comfortable.
FX Coudert Oct. 15, 2015, 2:59 p.m. UTC | #3
> In other words,
> consider youself a reviewer for patches in an area 
> of the compiler that you are comfortable.

Seconded.

FX
Dominique d'Humières Oct. 15, 2015, 4:31 p.m. UTC | #4
> Le 15 oct. 2015 à 16:59, FX <fxcoudert@gmail.com> a écrit :
> 
>> In other words,
>> consider youself a reviewer for patches in an area 
>> of the compiler that you are comfortable.
> 
> Seconded.
> 
> FX

Agreed,

Dominique
Paul Richard Thomas Oct. 15, 2015, 6:05 p.m. UTC | #5
Me too!

Paul

On 15 October 2015 at 18:31, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
>
>> Le 15 oct. 2015 à 16:59, FX <fxcoudert@gmail.com> a écrit :
>>
>>> In other words,
>>> consider youself a reviewer for patches in an area
>>> of the compiler that you are comfortable.
>>
>> Seconded.
>>
>> FX
>
> Agreed,
>
> Dominique
>
Mikael Morin Oct. 18, 2015, 12:57 p.m. UTC | #6
Le 15/10/2015 12:18, Andre Vehreschild a écrit :
> Hi Mikael, hi all,
>
> I have checked that the patch (my initial one for pr59678) does compile
> and test fine. Given that the patch lives in trunk-6 for quite some
> time now, without any major complaints, I approve to commit to gcc-5.
Thanks, I'll proceed.

Mikael
diff mbox

Patch

2015-10-04  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/67721
	PR fortran/67818
	Backport from mainline r222477:

	2015-04-27  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/59678
	PR fortran/65841
	* trans-array.c (duplicate_allocatable): Fixed deep copy of
	allocatable components, which are liable for copy only, when
	they are allocated.
	(gfc_duplicate_allocatable): Add deep-copy code into if
	component allocated block. Needed interface change for that.
	(gfc_copy_allocatable_data): Supplying NULL_TREE for code to
	add into if-block for checking whether a component was
	allocated.
	(gfc_duplicate_allocatable_nocopy): Likewise.
	(structure_alloc_comps): Likewise.
	* trans-array.h: Likewise.
	* trans-expr.c (gfc_trans_alloc_subarray_assign): Likewise.
	* trans-openmp.c (gfc_walk_alloc_comps): Likewise.

2015-10-04  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/67721
	PR fortran/67818
	Backport from mainline r222477:

	2015-04-27  Andre Vehreschild  <vehre@gmx.de>

	PR fortran/59678
	PR fortran/65841
	* gfortran.dg/alloc_comp_deep_copy_1.f03: New test.
	* gfortran.dg/alloc_comp_deep_copy_2.f03: New test.

Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(révision 228338)
+++ gcc/fortran/trans-array.c	(copie de travail)
@@ -7468,7 +7468,8 @@  gfc_full_array_size (stmtblock_t *block, tree decl
 
 static tree
 duplicate_allocatable (tree dest, tree src, tree type, int rank,
-		       bool no_malloc, bool no_memcpy, tree str_sz)
+		       bool no_malloc, bool no_memcpy, tree str_sz,
+		       tree add_when_allocated)
 {
   tree tmp;
   tree size;
@@ -7548,6 +7549,7 @@  duplicate_allocatable (tree dest, tree src, tree t
 	}
     }
 
+  gfc_add_expr_to_block (&block, add_when_allocated);
   tmp = gfc_finish_block (&block);
 
   /* Null the destination if the source is null; otherwise do
@@ -7567,10 +7569,11 @@  duplicate_allocatable (tree dest, tree src, tree t
 /* Allocate dest to the same size as src, and copy data src -> dest.  */
 
 tree
-gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank)
+gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank,
+			   tree add_when_allocated)
 {
   return duplicate_allocatable (dest, src, type, rank, false, false,
-				NULL_TREE);
+				NULL_TREE, add_when_allocated);
 }
 
 
@@ -7580,7 +7583,7 @@  tree
 gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank)
 {
   return duplicate_allocatable (dest, src, type, rank, true, false,
-				NULL_TREE);
+				NULL_TREE, NULL_TREE);
 }
 
 /* Allocate dest to the same size as src, but don't copy anything.  */
@@ -7588,7 +7591,8 @@  gfc_copy_allocatable_data (tree dest, tree src, tr
 tree
 gfc_duplicate_allocatable_nocopy (tree dest, tree src, tree type, int rank)
 {
-  return duplicate_allocatable (dest, src, type, rank, false, true, NULL_TREE);
+  return duplicate_allocatable (dest, src, type, rank, false, true,
+				NULL_TREE, NULL_TREE);
 }
 
 
@@ -7620,6 +7624,7 @@  structure_alloc_comps (gfc_symbol * der_type, tree
   tree ctype;
   tree vref, dref;
   tree null_cond = NULL_TREE;
+  tree add_when_allocated;
   bool called_dealloc_with_status;
 
   gfc_init_block (&fnblock);
@@ -7626,21 +7631,25 @@  structure_alloc_comps (gfc_symbol * der_type, tree
 
   decl_type = TREE_TYPE (decl);
 
-  if ((POINTER_TYPE_P (decl_type) && rank != 0)
+  if ((POINTER_TYPE_P (decl_type))
 	|| (TREE_CODE (decl_type) == REFERENCE_TYPE && rank == 0))
-    decl = build_fold_indirect_ref_loc (input_location, decl);
+    {
+      decl = build_fold_indirect_ref_loc (input_location, decl);
+      /* Deref dest in sync with decl, but only when it is not NULL.  */
+      if (dest)
+	dest = build_fold_indirect_ref_loc (input_location, dest);
+    }
 
-  /* Just in case in gets dereferenced.  */
+  /* Just in case it gets dereferenced.  */
   decl_type = TREE_TYPE (decl);
 
-  /* If this an array of derived types with allocatable components
+  /* If this is an array of derived types with allocatable components
      build a loop and recursively call this function.  */
   if (TREE_CODE (decl_type) == ARRAY_TYPE
       || (GFC_DESCRIPTOR_TYPE_P (decl_type) && rank != 0))
     {
       tmp = gfc_conv_array_data (decl);
-      var = build_fold_indirect_ref_loc (input_location,
-				     tmp);
+      var = build_fold_indirect_ref_loc (input_location, tmp);
 
       /* Get the number of elements - 1 and set the counter.  */
       if (GFC_DESCRIPTOR_TYPE_P (decl_type))
@@ -7661,7 +7670,7 @@  structure_alloc_comps (gfc_symbol * der_type, tree
       else
 	{
 	  /*  Otherwise use the TYPE_DOMAIN information.  */
-	  tmp =  array_type_nelts (decl_type);
+	  tmp = array_type_nelts (decl_type);
 	  tmp = fold_convert (gfc_array_index_type, tmp);
 	}
 
@@ -7674,23 +7683,11 @@  structure_alloc_comps (gfc_symbol * der_type, tree
 
       vref = gfc_build_array_ref (var, index, NULL);
 
-      if (purpose == COPY_ALLOC_COMP)
+      if (purpose == COPY_ALLOC_COMP || purpose == COPY_ONLY_ALLOC_COMP)
         {
-	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
-	    {
-	      tmp = gfc_duplicate_allocatable (dest, decl, decl_type, rank);
-	      gfc_add_expr_to_block (&fnblock, tmp);
-	    }
 	  tmp = build_fold_indirect_ref_loc (input_location,
 					 gfc_conv_array_data (dest));
 	  dref = gfc_build_array_ref (tmp, index, NULL);
-	  tmp = structure_alloc_comps (der_type, vref, dref, rank, purpose);
-	}
-      else if (purpose == COPY_ONLY_ALLOC_COMP)
-        {
-	  tmp = build_fold_indirect_ref_loc (input_location,
-					 gfc_conv_array_data (dest));
-	  dref = gfc_build_array_ref (tmp, index, NULL);
 	  tmp = structure_alloc_comps (der_type, vref, dref, rank,
 				       COPY_ALLOC_COMP);
 	}
@@ -7709,7 +7706,17 @@  structure_alloc_comps (gfc_symbol * der_type, tree
       gfc_add_block_to_block (&fnblock, &loop.pre);
 
       tmp = gfc_finish_block (&fnblock);
-      if (null_cond != NULL_TREE)
+      /* When copying allocateable components, the above implements the
+	 deep copy.  Nevertheless is a deep copy only allowed, when the current
+	 component is allocated, for which code will be generated in
+	 gfc_duplicate_allocatable (), where the deep copy code is just added
+	 into the if's body, by adding tmp (the deep copy code) as last
+	 argument to gfc_duplicate_allocatable ().  */
+      if (purpose == COPY_ALLOC_COMP
+	  && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
+	tmp = gfc_duplicate_allocatable (dest, decl, decl_type, rank,
+					 tmp);
+      else if (null_cond != NULL_TREE)
 	tmp = build3_v (COND_EXPR, null_cond, tmp,
 			build_empty_stmt (input_location));
 
@@ -7994,6 +8001,22 @@  structure_alloc_comps (gfc_symbol * der_type, tree
 	      continue;
 	    }
 
+	  /* To implement guarded deep copy, i.e., deep copy only allocatable
+	     components that are really allocated, the deep copy code has to
+	     be generated first and then added to the if-block in
+	     gfc_duplicate_allocatable ().  */
+	  if (cmp_has_alloc_comps)
+	    {
+	      rank = c->as ? c->as->rank : 0;
+	      tmp = fold_convert (TREE_TYPE (dcmp), comp);
+	      gfc_add_modify (&fnblock, dcmp, tmp);
+	      add_when_allocated = structure_alloc_comps (c->ts.u.derived,
+							  comp, dcmp,
+							  rank, purpose);
+	    }
+	  else
+	    add_when_allocated = NULL_TREE;
+
 	  if (gfc_deferred_strlen (c, &tmp))
 	    {
 	      tree len, size;
@@ -8008,30 +8031,29 @@  structure_alloc_comps (gfc_symbol * der_type, tree
 				     TREE_TYPE (len), len, tmp);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	      size = size_of_string_in_bytes (c->ts.kind, len);
+	      /* This component can not have allocatable components,
+		 therefore add_when_allocated of duplicate_allocatable ()
+		 is always NULL.  */
 	      tmp = duplicate_allocatable (dcmp, comp, ctype, rank,
-					   false, false, size);
+					   false, false, size, NULL_TREE);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 	  else if (c->attr.allocatable && !c->attr.proc_pointer
-		   && !cmp_has_alloc_comps)
+		   && (!(cmp_has_alloc_comps && c->as)
+		       || c->attr.codimension))
 	    {
 	      rank = c->as ? c->as->rank : 0;
 	      if (c->attr.codimension)
 		tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank);
 	      else
-		tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank);
+		tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank,
+						 add_when_allocated);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
+	  else
+	    if (cmp_has_alloc_comps)
+	      gfc_add_expr_to_block (&fnblock, add_when_allocated);
 
-          if (cmp_has_alloc_comps)
-	    {
-	      rank = c->as ? c->as->rank : 0;
-	      tmp = fold_convert (TREE_TYPE (dcmp), comp);
-	      gfc_add_modify (&fnblock, dcmp, tmp);
-	      tmp = structure_alloc_comps (c->ts.u.derived, comp, dcmp,
-					   rank, purpose);
-	      gfc_add_expr_to_block (&fnblock, tmp);
-	    }
 	  break;
 
 	default:
Index: gcc/fortran/trans-array.h
===================================================================
--- gcc/fortran/trans-array.h	(révision 228338)
+++ gcc/fortran/trans-array.h	(copie de travail)
@@ -46,7 +46,7 @@  tree gfc_trans_dealloc_allocated (tree, bool, gfc_
 
 tree gfc_full_array_size (stmtblock_t *, tree, int);
 
-tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank);
+tree gfc_duplicate_allocatable (tree, tree, tree, int, tree);
 
 tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank);
 
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(révision 228339)
+++ gcc/fortran/trans-expr.c	(copie de travail)
@@ -6563,13 +6563,13 @@  gfc_trans_alloc_subarray_assign (tree dest, gfc_co
 	{
 	  tmp = TREE_TYPE (dest);
 	  tmp = gfc_duplicate_allocatable (dest, se.expr,
-					   tmp, expr->rank);
+					   tmp, expr->rank, NULL_TREE);
 	}
     }
   else
     tmp = gfc_duplicate_allocatable (dest, se.expr,
 				     TREE_TYPE(cm->backend_decl),
-				     cm->as->rank);
+				     cm->as->rank, NULL_TREE);
 
   gfc_add_expr_to_block (&block, tmp);
   gfc_add_block_to_block (&block, &se.post);
Index: gcc/fortran/trans-openmp.c
===================================================================
--- gcc/fortran/trans-openmp.c	(révision 228338)
+++ gcc/fortran/trans-openmp.c	(copie de travail)
@@ -391,9 +391,11 @@  gfc_walk_alloc_comps (tree decl, tree dest, tree v
 	  if (GFC_DESCRIPTOR_TYPE_P (ftype)
 	      && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
 	    tem = gfc_duplicate_allocatable (destf, declf, ftype,
-					     GFC_TYPE_ARRAY_RANK (ftype));
+					     GFC_TYPE_ARRAY_RANK (ftype),
+					     NULL_TREE);
 	  else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
-	    tem = gfc_duplicate_allocatable (destf, declf, ftype, 0);
+	    tem = gfc_duplicate_allocatable (destf, declf, ftype, 0,
+					     NULL_TREE);
 	  break;
 	}
       if (tem)
Index: gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03
===================================================================
--- gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03	(révision 0)
+++ gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03	(copie de travail)
@@ -0,0 +1,270 @@ 
+! { dg-do run }
+!
+! Check fix for correctly deep copying allocatable components.
+! PR fortran/59678
+! Contributed by Andre Vehreschild  <vehre@gmx.de>
+!
+program alloc_comp_copy_test
+
+  type InnerT
+    integer :: ii
+    integer, allocatable :: ai
+    integer, allocatable :: v(:)
+  end type InnerT
+
+  type T
+    integer :: i
+    integer, allocatable :: a_i
+    type(InnerT), allocatable :: it
+    type(InnerT), allocatable :: vec(:)
+  end type T
+
+  type(T) :: o1, o2
+  class(T), allocatable :: o3, o4
+  o1%i = 42
+
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (allocated(o2%a_i)) call abort()
+  if (allocated(o2%it)) call abort()
+  if (allocated(o2%vec)) call abort()
+
+  allocate (o1%a_i, source=2)
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (allocated(o2%it)) call abort()
+  if (allocated(o2%vec)) call abort()
+
+  allocate (o1%it)
+  o1%it%ii = 3
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (.not. allocated(o2%it)) call abort()
+  if (o2%it%ii /= 3) call abort()
+  if (allocated(o2%it%ai)) call abort()
+  if (allocated(o2%it%v)) call abort()
+  if (allocated(o2%vec)) call abort()
+
+  allocate (o1%it%ai)
+  o1%it%ai = 4
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (.not. allocated(o2%it)) call abort()
+  if (o2%it%ii /= 3) call abort()
+  if (.not. allocated(o2%it%ai)) call abort()
+  if (o2%it%ai /= 4) call abort()
+  if (allocated(o2%it%v)) call abort()
+  if (allocated(o2%vec)) call abort()
+
+  allocate (o1%it%v(3), source= 5)
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (.not. allocated(o2%it)) call abort()
+  if (o2%it%ii /= 3) call abort()
+  if (.not. allocated(o2%it%ai)) call abort()
+  if (o2%it%ai /= 4) call abort()
+  if (.not. allocated(o2%it%v)) call abort()
+  if (any (o2%it%v /= 5) .or. size (o2%it%v) /= 3) call abort()
+  if (allocated(o2%vec)) call abort()
+
+  allocate (o1%vec(2))
+  o1%vec(:)%ii = 6
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (.not. allocated(o2%it)) call abort()
+  if (o2%it%ii /= 3) call abort()
+  if (.not. allocated(o2%it%ai)) call abort()
+  if (o2%it%ai /= 4) call abort()
+  if (.not. allocated(o2%it%v)) call abort()
+  if (size (o2%it%v) /= 3) call abort()
+  if (any (o2%it%v /= 5)) call abort()
+  if (.not. allocated(o2%vec)) call abort()
+  if (size(o2%vec) /= 2) call abort()
+  if (any(o2%vec(:)%ii /= 6)) call abort()
+  if (allocated(o2%vec(1)%ai) .or. allocated(o2%vec(2)%ai)) call abort()
+  if (allocated(o2%vec(1)%v) .or. allocated(o2%vec(2)%v)) call abort()
+
+  allocate (o1%vec(2)%ai)
+  o1%vec(2)%ai = 7
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (.not. allocated(o2%it)) call abort()
+  if (o2%it%ii /= 3) call abort()
+  if (.not. allocated(o2%it%ai)) call abort()
+  if (o2%it%ai /= 4) call abort()
+  if (.not. allocated(o2%it%v)) call abort()
+  if (size (o2%it%v) /= 3) call abort()
+  if (any (o2%it%v /= 5)) call abort()
+  if (.not. allocated(o2%vec)) call abort()
+  if (size(o2%vec) /= 2) call abort()
+  if (any(o2%vec(:)%ii /= 6)) call abort()
+  if (allocated(o2%vec(1)%ai)) call abort()
+  if (.not. allocated(o2%vec(2)%ai)) call abort()
+  if (o2%vec(2)%ai /= 7) call abort()
+  if (allocated(o2%vec(1)%v) .or. allocated(o2%vec(2)%v)) call abort()
+
+  allocate (o1%vec(1)%v(3))
+  o1%vec(1)%v = [8, 9, 10]
+  call copyO(o1, o2)
+  if (o2%i /= 42) call abort ()
+  if (.not. allocated(o2%a_i)) call abort()
+  if (o2%a_i /= 2) call abort()
+  if (.not. allocated(o2%it)) call abort()
+  if (o2%it%ii /= 3) call abort()
+  if (.not. allocated(o2%it%ai)) call abort()
+  if (o2%it%ai /= 4) call abort()
+  if (.not. allocated(o2%it%v)) call abort()
+  if (size (o2%it%v) /= 3) call abort()
+  if (any (o2%it%v /= 5)) call abort()
+  if (.not. allocated(o2%vec)) call abort()
+  if (size(o2%vec) /= 2) call abort()
+  if (any(o2%vec(:)%ii /= 6)) call abort()
+  if (allocated(o2%vec(1)%ai)) call abort()
+  if (.not. allocated(o2%vec(2)%ai)) call abort()
+  if (o2%vec(2)%ai /= 7) call abort()
+  if (.not. allocated(o2%vec(1)%v)) call abort()
+  if (any (o2%vec(1)%v /= [8,9,10])) call abort()
+  if (allocated(o2%vec(2)%v)) call abort()
+
+  ! Now all the above for class objects.
+  allocate (o3, o4)
+  o3%i = 42
+
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (allocated(o4%a_i)) call abort()
+  if (allocated(o4%it)) call abort()
+  if (allocated(o4%vec)) call abort()
+
+  allocate (o3%a_i, source=2)
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (allocated(o4%it)) call abort()
+  if (allocated(o4%vec)) call abort()
+
+  allocate (o3%it)
+  o3%it%ii = 3
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (.not. allocated(o4%it)) call abort()
+  if (o4%it%ii /= 3) call abort()
+  if (allocated(o4%it%ai)) call abort()
+  if (allocated(o4%it%v)) call abort()
+  if (allocated(o4%vec)) call abort()
+
+  allocate (o3%it%ai)
+  o3%it%ai = 4
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (.not. allocated(o4%it)) call abort()
+  if (o4%it%ii /= 3) call abort()
+  if (.not. allocated(o4%it%ai)) call abort()
+  if (o4%it%ai /= 4) call abort()
+  if (allocated(o4%it%v)) call abort()
+  if (allocated(o4%vec)) call abort()
+
+  allocate (o3%it%v(3), source= 5)
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (.not. allocated(o4%it)) call abort()
+  if (o4%it%ii /= 3) call abort()
+  if (.not. allocated(o4%it%ai)) call abort()
+  if (o4%it%ai /= 4) call abort()
+  if (.not. allocated(o4%it%v)) call abort()
+  if (any (o4%it%v /= 5) .or. size (o4%it%v) /= 3) call abort()
+  if (allocated(o4%vec)) call abort()
+
+  allocate (o3%vec(2))
+  o3%vec(:)%ii = 6
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (.not. allocated(o4%it)) call abort()
+  if (o4%it%ii /= 3) call abort()
+  if (.not. allocated(o4%it%ai)) call abort()
+  if (o4%it%ai /= 4) call abort()
+  if (.not. allocated(o4%it%v)) call abort()
+  if (size (o4%it%v) /= 3) call abort()
+  if (any (o4%it%v /= 5)) call abort()
+  if (.not. allocated(o4%vec)) call abort()
+  if (size(o4%vec) /= 2) call abort()
+  if (any(o4%vec(:)%ii /= 6)) call abort()
+  if (allocated(o4%vec(1)%ai) .or. allocated(o4%vec(2)%ai)) call abort()
+  if (allocated(o4%vec(1)%v) .or. allocated(o4%vec(2)%v)) call abort()
+
+  allocate (o3%vec(2)%ai)
+  o3%vec(2)%ai = 7
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (.not. allocated(o4%it)) call abort()
+  if (o4%it%ii /= 3) call abort()
+  if (.not. allocated(o4%it%ai)) call abort()
+  if (o4%it%ai /= 4) call abort()
+  if (.not. allocated(o4%it%v)) call abort()
+  if (size (o4%it%v) /= 3) call abort()
+  if (any (o4%it%v /= 5)) call abort()
+  if (.not. allocated(o4%vec)) call abort()
+  if (size(o4%vec) /= 2) call abort()
+  if (any(o4%vec(:)%ii /= 6)) call abort()
+  if (allocated(o4%vec(1)%ai)) call abort()
+  if (.not. allocated(o4%vec(2)%ai)) call abort()
+  if (o4%vec(2)%ai /= 7) call abort()
+  if (allocated(o4%vec(1)%v) .or. allocated(o4%vec(2)%v)) call abort()
+
+  allocate (o3%vec(1)%v(3))
+  o3%vec(1)%v = [8, 9, 10]
+  call copyO(o3, o4)
+  if (o4%i /= 42) call abort ()
+  if (.not. allocated(o4%a_i)) call abort()
+  if (o4%a_i /= 2) call abort()
+  if (.not. allocated(o4%it)) call abort()
+  if (o4%it%ii /= 3) call abort()
+  if (.not. allocated(o4%it%ai)) call abort()
+  if (o4%it%ai /= 4) call abort()
+  if (.not. allocated(o4%it%v)) call abort()
+  if (size (o4%it%v) /= 3) call abort()
+  if (any (o4%it%v /= 5)) call abort()
+  if (.not. allocated(o4%vec)) call abort()
+  if (size(o4%vec) /= 2) call abort()
+  if (any(o4%vec(:)%ii /= 6)) call abort()
+  if (allocated(o4%vec(1)%ai)) call abort()
+  if (.not. allocated(o4%vec(2)%ai)) call abort()
+  if (o4%vec(2)%ai /= 7) call abort()
+  if (.not. allocated(o4%vec(1)%v)) call abort()
+  if (any (o4%vec(1)%v /= [8,9,10])) call abort()
+  if (allocated(o4%vec(2)%v)) call abort()
+
+contains
+
+  subroutine copyO(src, dst)
+    type(T), intent(in) :: src
+    type(T), intent(out) :: dst
+
+    dst = src
+  end subroutine copyO
+
+end program alloc_comp_copy_test
+
Index: gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_2.f03
===================================================================
--- gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_2.f03	(révision 0)
+++ gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_2.f03	(copie de travail)
@@ -0,0 +1,21 @@ 
+! { dg-do run }
+!
+! Testcase for PR fortran/65841
+! Contributed by Damian Rousson
+!
+program alloc_comp_deep_copy_2
+  type a
+    real, allocatable :: f
+  end type
+  type b
+    type(a), allocatable :: g
+  end type
+
+  type(b) c,d
+
+  c%g=a(1.) 
+  d=c
+  if (d%g%f /= 1.0) call abort()
+  d%g%f = 2.0
+  if (d%g%f /= 2.0) call abort()
+end program