* [Patch, fortran, pr59678, v1] -- [F03] Segfault on equalizing variables of a complex derived type
@ 2015-04-18 10:55 Andre Vehreschild
2015-04-25 14:42 ` Paul Richard Thomas
0 siblings, 1 reply; 4+ messages in thread
From: Andre Vehreschild @ 2015-04-18 10:55 UTC (permalink / raw)
To: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 1367 bytes --]
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
[-- Attachment #2: pr59678_1.clog --]
[-- Type: application/octet-stream, Size: 835 bytes --]
gcc/testsuite/ChangeLog:
2015-04-18 Andre Vehreschild <vehre@gmx.de>
* gfortran.dg/alloc_comp_deep_copy_1.f03: New test.
gcc/fortran/ChangeLog:
2015-04-18 Andre Vehreschild <vehre@gmx.de>
PR fortran/59678
* 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.
[-- Attachment #3: pr59678_1.patch --]
[-- Type: text/x-patch, Size: 18702 bytes --]
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
+
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran, pr59678, v1] -- [F03] Segfault on equalizing variables of a complex derived type
2015-04-18 10:55 [Patch, fortran, pr59678, v1] -- [F03] Segfault on equalizing variables of a complex derived type Andre Vehreschild
@ 2015-04-25 14:42 ` Paul Richard Thomas
2015-04-25 14:46 ` Paul Richard Thomas
2015-04-27 17:40 ` Andre Vehreschild
0 siblings, 2 replies; 4+ messages in thread
From: Paul Richard Thomas @ 2015-04-25 14:42 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML
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
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran, pr59678, v1] -- [F03] Segfault on equalizing variables of a complex derived type
2015-04-25 14:42 ` Paul Richard Thomas
@ 2015-04-25 14:46 ` Paul Richard Thomas
2015-04-27 17:40 ` Andre Vehreschild
1 sibling, 0 replies; 4+ messages in thread
From: Paul Richard Thomas @ 2015-04-25 14:46 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML
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
--
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.
Groucho Marx
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran, pr59678, v1] -- [F03] Segfault on equalizing variables of a complex derived type
2015-04-25 14:42 ` Paul Richard Thomas
2015-04-25 14:46 ` Paul Richard Thomas
@ 2015-04-27 17:40 ` Andre Vehreschild
1 sibling, 0 replies; 4+ messages in thread
From: Andre Vehreschild @ 2015-04-27 17:40 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 2434 bytes --]
Hi Paul, hi all,
Paul, thanks for the review. I have integrated all your comments (i) to (iii)
and commited as r222477.
Regards,
Andre
On Sat, 25 Apr 2015 16:42:52 +0200
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
>
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 20585 bytes --]
Index: gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_2.f03
===================================================================
--- gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_2.f03 (Revision 0)
+++ gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_2.f03 (Revision 222477)
@@ -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
Index: gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03
===================================================================
--- gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03 (Revision 0)
+++ gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_1.f03 (Revision 222477)
@@ -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/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 222476)
+++ gcc/testsuite/ChangeLog (Revision 222477)
@@ -1,3 +1,10 @@
+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.
+
2015-04-27 Caroline Tice <cmtice@google.com>
* gcc.dg/tree-prof/cold_partition_label.c (main): Check for cold
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 222476)
+++ gcc/fortran/trans-expr.c (Revision 222477)
@@ -6713,13 +6713,13 @@
{
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-array.c
===================================================================
--- gcc/fortran/trans-array.c (Revision 222476)
+++ gcc/fortran/trans-array.c (Revision 222477)
@@ -7523,7 +7523,8 @@
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;
@@ -7603,6 +7604,7 @@
}
}
+ gfc_add_expr_to_block (&block, add_when_allocated);
tmp = gfc_finish_block (&block);
/* Null the destination if the source is null; otherwise do
@@ -7622,10 +7624,11 @@
/* 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);
}
@@ -7635,7 +7638,7 @@
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. */
@@ -7643,7 +7646,8 @@
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);
}
@@ -7675,6 +7679,7 @@
tree ctype;
tree vref, dref;
tree null_cond = NULL_TREE;
+ tree add_when_allocated;
bool called_dealloc_with_status;
gfc_init_block (&fnblock);
@@ -7681,21 +7686,25 @@
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))
@@ -7716,7 +7725,7 @@
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);
}
@@ -7729,23 +7738,11 @@
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);
}
@@ -7764,7 +7761,17 @@
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));
@@ -8049,6 +8056,22 @@
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;
@@ -8063,30 +8086,29 @@
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 (Revision 222476)
+++ gcc/fortran/trans-array.h (Revision 222477)
@@ -46,7 +46,7 @@
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-openmp.c
===================================================================
--- gcc/fortran/trans-openmp.c (Revision 222476)
+++ gcc/fortran/trans-openmp.c (Revision 222477)
@@ -391,9 +391,11 @@
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/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 222476)
+++ gcc/fortran/ChangeLog (Revision 222477)
@@ -1,3 +1,21 @@
+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-04-23 Andre Vehreschild <vehre@gmx.de>
PR fortran/60322
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2015-04-27 17:40 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-04-18 10:55 [Patch, fortran, pr59678, v1] -- [F03] Segfault on equalizing variables of a complex derived type Andre Vehreschild
2015-04-25 14:42 ` Paul Richard Thomas
2015-04-25 14:46 ` Paul Richard Thomas
2015-04-27 17:40 ` Andre Vehreschild
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).