diff mbox

[fortran,pr59678,v1] -- [F03] Segfault on equalizing variables of a complex derived type

Message ID 20150418125542.3006a969@gmx.de
State New
Headers show

Commit Message

Andre Vehreschild April 18, 2015, 10:55 a.m. UTC 
Hi all,

this patch fixes a deep copy issue, when allocatable components of an entity
were not allocated. Before the patch the deep copy was run without
checking if the component is actually allocated and the program crashed because
a null pointer was dereferenced. Furthermore, was the code to copy a structure
component not checking the correct ref to determine whether a component was
allocated, when allocatable components were nested. Example:

type InnerT
  integer, allocatable :: inner_I
end type
type T
  type(InnerT), allocatable :: in
end type

The pseudo pseudo code generated for this was something like:

subroutine copy(src,dst)
  dst = src
  if (allocated (src.in.inner_I)) // crash
    allocate (dst.in)
  end if

  dst.in.inner_I = src.in.inner_I // crash
end subroutine

The patch fixes this by generating:

subroutine copy(src,dst)
  dst = src
  if (allocated (src.in))
    allocate (dst.in)
    dst.in= src.in
    if (allocated (src.in.inner_I))
      allocate (dst.in.inner_I)
      dst.in.inner_I = src.in.inner_I
    end
  end
end subroutine

Of course is this pseudo pseudo code shortened dramatically to show just the
necessary bits.

Bootstraps and regtests ok on x86_64-linux-gnu/F21.

Ok, for trunk?

Thanks to Dominique for identifying the pr addressed by this patch.

Regards,
	Andre

Comments

Paul Richard Thomas April 25, 2015, 2:42 p.m. UTC | #1 
Dear Andre,

The patch is OK with three changes:
(i) Put the PR line in the testsuite ChangeLog;
(ii) Put the dg-do header information in the testcase, together with
lines to say which PR it fixes and who the contributor is; and
(iii) Add the testcase for PR65841 since your patch for pr65792 breaks
this side-effect fix.

I will turn my attention to your patch for pr65792 next and try to
figure out why (iii) is necessary.

Thanks for the patch

Paul



On 18 April 2015 at 12:55, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi all,
>
> this patch fixes a deep copy issue, when allocatable components of an entity
> were not allocated. Before the patch the deep copy was run without
> checking if the component is actually allocated and the program crashed because
> a null pointer was dereferenced. Furthermore, was the code to copy a structure
> component not checking the correct ref to determine whether a component was
> allocated, when allocatable components were nested. Example:
>
> type InnerT
>   integer, allocatable :: inner_I
> end type
> type T
>   type(InnerT), allocatable :: in
> end type
>
> The pseudo pseudo code generated for this was something like:
>
> subroutine copy(src,dst)
>   dst = src
>   if (allocated (src.in.inner_I)) // crash
>     allocate (dst.in)
>   end if
>
>   dst.in.inner_I = src.in.inner_I // crash
> end subroutine
>
> The patch fixes this by generating:
>
> subroutine copy(src,dst)
>   dst = src
>   if (allocated (src.in))
>     allocate (dst.in)
>     dst.in= src.in
>     if (allocated (src.in.inner_I))
>       allocate (dst.in.inner_I)
>       dst.in.inner_I = src.in.inner_I
>     end
>   end
> end subroutine
>
> Of course is this pseudo pseudo code shortened dramatically to show just the
> necessary bits.
>
> Bootstraps and regtests ok on x86_64-linux-gnu/F21.
>
> Ok, for trunk?
>
> Thanks to Dominique for identifying the pr addressed by this patch.
>
> Regards,
>         Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
Paul Richard Thomas April 25, 2015, 2:46 p.m. UTC | #2 
Dear Andre,

Sorry, Mikael's patch for pr65792!

Also, your patch for PR59678 had better be applied to 5.1 and to 4.9,
since bug generates such grossly wrong code.

Cheers

Paul

On 25 April 2015 at 16:42, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Dear Andre,
>
> The patch is OK with three changes:
> (i) Put the PR line in the testsuite ChangeLog;
> (ii) Put the dg-do header information in the testcase, together with
> lines to say which PR it fixes and who the contributor is; and
> (iii) Add the testcase for PR65841 since your patch for pr65792 breaks
> this side-effect fix.
>
> I will turn my attention to your patch for pr65792 next and try to
> figure out why (iii) is necessary.
>
> Thanks for the patch
>
> Paul
>
>
>
> On 18 April 2015 at 12:55, Andre Vehreschild <vehre@gmx.de> wrote:
>> Hi all,
>>
>> this patch fixes a deep copy issue, when allocatable components of an entity
>> were not allocated. Before the patch the deep copy was run without
>> checking if the component is actually allocated and the program crashed because
>> a null pointer was dereferenced. Furthermore, was the code to copy a structure
>> component not checking the correct ref to determine whether a component was
>> allocated, when allocatable components were nested. Example:
>>
>> type InnerT
>>   integer, allocatable :: inner_I
>> end type
>> type T
>>   type(InnerT), allocatable :: in
>> end type
>>
>> The pseudo pseudo code generated for this was something like:
>>
>> subroutine copy(src,dst)
>>   dst = src
>>   if (allocated (src.in.inner_I)) // crash
>>     allocate (dst.in)
>>   end if
>>
>>   dst.in.inner_I = src.in.inner_I // crash
>> end subroutine
>>
>> The patch fixes this by generating:
>>
>> subroutine copy(src,dst)
>>   dst = src
>>   if (allocated (src.in))
>>     allocate (dst.in)
>>     dst.in= src.in
>>     if (allocated (src.in.inner_I))
>>       allocate (dst.in.inner_I)
>>       dst.in.inner_I = src.in.inner_I
>>     end
>>   end
>> end subroutine
>>
>> Of course is this pseudo pseudo code shortened dramatically to show just the
>> necessary bits.
>>
>> Bootstraps and regtests ok on x86_64-linux-gnu/F21.
>>
>> Ok, for trunk?
>>
>> Thanks to Dominique for identifying the pr addressed by this patch.
>>
>> Regards,
>>         Andre
>> --
>> Andre Vehreschild * Email: vehre ad gmx dot de
>
>
>
> --
> Outside of a dog, a book is a man's best friend. Inside of a dog it's
> too dark to read.
>
> Groucho Marx
diff mbox

Patch

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 1cb639d..08c8861 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7574,7 +7574,8 @@  gfc_full_array_size (stmtblock_t *block, tree decl, int rank)
 
 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;
@@ -7654,6 +7655,7 @@  duplicate_allocatable (tree dest, tree src, tree type, int rank,
 	}
     }
 
+  gfc_add_expr_to_block (&block, add_when_allocated);
   tmp = gfc_finish_block (&block);
 
   /* Null the destination if the source is null; otherwise do
@@ -7673,10 +7675,11 @@  duplicate_allocatable (tree dest, tree src, tree type, int rank,
 /* 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);
 }
 
 
@@ -7686,7 +7689,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.  */
@@ -7694,7 +7697,8 @@  gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank)
 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);
 }
 
 
@@ -7726,27 +7730,32 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl,
   tree ctype;
   tree vref, dref;
   tree null_cond = NULL_TREE;
+  tree add_when_allocated;
   bool called_dealloc_with_status;
 
   gfc_init_block (&fnblock);
 
   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))
@@ -7767,7 +7776,7 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl,
       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);
 	}
 
@@ -7780,19 +7789,7 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl,
 
       vref = gfc_build_array_ref (var, index, NULL);
 
-      if (purpose == COPY_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)
+      if (purpose == COPY_ALLOC_COMP || purpose == COPY_ONLY_ALLOC_COMP)
         {
 	  tmp = build_fold_indirect_ref_loc (input_location,
 					 gfc_conv_array_data (dest));
@@ -7815,7 +7812,17 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl,
       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));
 
@@ -8100,6 +8107,22 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	      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;
@@ -8114,30 +8137,29 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl,
 				     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:
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 389a644..2132f84 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -46,7 +46,7 @@  tree gfc_trans_dealloc_allocated (tree, bool, gfc_expr *);
 
 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);
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 80dfed1..395c47d 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6725,13 +6725,13 @@  gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
 	{
 	  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);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 9642a7d..dd19a9c 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -391,9 +391,11 @@  gfc_walk_alloc_comps (tree decl, tree dest, tree var,
 	  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)
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03
new file mode 100644
index 0000000..98a7da3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03
@@ -0,0 +1,264 @@ 
+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
+