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
pr59678_1.clog
Description: Binary data
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
+
