* [Patch, Fortran] Coarrays: Don't (free)/alloc LHS coarray components on assignment
@ 2013-06-22 18:19 Tobias Burnus
2013-06-26 21:00 ` Tobias Burnus
0 siblings, 1 reply; 4+ messages in thread
From: Tobias Burnus @ 2013-06-22 18:19 UTC (permalink / raw)
To: gcc patches, gfortran
[-- Attachment #1: Type: text/plain, Size: 813 bytes --]
With coarrays, allocation/deallocation of coarrays requires a
synchronization with all other images. Thus, the standard restricts
changing the allocation status to: ALLOCATE and DEALLOCATE statements
plus end-of-scope deallocation.
In particular, with intrinsic assignment the allocation status does not
change. Hence, there is no realloc on assignment. But also (this patch!)
no deallocation/allocation of allocatable components during intrinsic
assignment of derived types. [This implies that the LHS componet has to
have the same allocation status, shape, type-parameters and actual type
as the RHS.]
The patch additionally checks whether end-of-scope deallocation of
coarrays properly calls the deregister function (it did/does).
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
[-- Attachment #2: caf_norealloc.diff --]
[-- Type: text/x-patch, Size: 8527 bytes --]
2013-06-22 Tobias Burnus <burnus@net-b.de>
* trans-array.h (gfc_deallocate_alloc_comp_no_caf): New
prototype.
* trans-array.c (enum): Add DEALLOCATE_ALLOC_COMP_NO_CAF.
(structure_alloc_comps): Handle it.
(gfc_deallocate_alloc_comp_no_caf): New function.
(gfc_alloc_allocatable_for_assignment): Call it.
* trans-expr.c (gfc_trans_scalar_assign,
gfc_trans_arrayfunc_assign, gfc_trans_assignment_1): Ditto.
2013-06-22 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray_lib_realloc_1.f90: New.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 96162e5..076a6df 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7414,8 +7414,8 @@ gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank)
deallocate, nullify or copy allocatable components. This is the work horse
function for the functions named in this enum. */
-enum {DEALLOCATE_ALLOC_COMP = 1, NULLIFY_ALLOC_COMP, COPY_ALLOC_COMP,
- COPY_ONLY_ALLOC_COMP};
+enum {DEALLOCATE_ALLOC_COMP = 1, DEALLOCATE_ALLOC_COMP_NO_CAF,
+ NULLIFY_ALLOC_COMP, COPY_ALLOC_COMP, COPY_ONLY_ALLOC_COMP};
static tree
structure_alloc_comps (gfc_symbol * der_type, tree decl,
@@ -7546,6 +7546,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
switch (purpose)
{
case DEALLOCATE_ALLOC_COMP:
+ case DEALLOCATE_ALLOC_COMP_NO_CAF:
/* gfc_deallocate_scalar_with_status calls gfc_deallocate_alloc_comp
(i.e. this function) so generate all the calls and suppress the
@@ -7553,15 +7554,17 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
called_dealloc_with_status = false;
gfc_init_block (&tmpblock);
- if (c->attr.allocatable && (c->attr.dimension || c->attr.codimension)
- && !c->attr.proc_pointer)
+ if (c->attr.allocatable && !c->attr.proc_pointer
+ && (c->attr.dimension
+ || (c->attr.codimension
+ && purpose != DEALLOCATE_ALLOC_COMP_NO_CAF)))
{
comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
tmp = gfc_trans_dealloc_allocated (comp, c->attr.codimension, NULL);
gfc_add_expr_to_block (&tmpblock, tmp);
}
- else if (c->attr.allocatable)
+ else if (c->attr.allocatable && !c->attr.codimension)
{
/* Allocatable scalar components. */
comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
@@ -7577,7 +7580,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
build_int_cst (TREE_TYPE (comp), 0));
gfc_add_expr_to_block (&tmpblock, tmp);
}
- else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
+ else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable
+ && (!CLASS_DATA (c)->attr.codimension
+ || purpose != DEALLOCATE_ALLOC_COMP_NO_CAF))
{
/* Allocatable CLASS components. */
comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
@@ -7713,10 +7718,17 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
gfc_init_block (&tmpblock);
- ftn_tree = builtin_decl_explicit (BUILT_IN_MALLOC);
- tmp = build_call_expr_loc (input_location, ftn_tree, 1, size);
- gfc_add_modify (&tmpblock, dst_data,
- fold_convert (TREE_TYPE (dst_data), tmp));
+ /* Coarray component have to have the same allocation status and
+ shape/type-parameter/effective-type on the LHS and RHS of an
+ intrinsic assignment. Hence, we did not deallocated them - and
+ do not allocate them here. */
+ if (!CLASS_DATA (c)->attr.codimension)
+ {
+ ftn_tree = builtin_decl_explicit (BUILT_IN_MALLOC);
+ tmp = build_call_expr_loc (input_location, ftn_tree, 1, size);
+ gfc_add_modify (&tmpblock, dst_data,
+ fold_convert (TREE_TYPE (dst_data), tmp));
+ }
tmp = gfc_copy_class_to_class (comp, dcmp, nelems);
gfc_add_expr_to_block (&tmpblock, tmp);
@@ -7741,7 +7753,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
&& !cmp_has_alloc_comps)
{
rank = c->as ? c->as->rank : 0;
- tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank);
+ if (c->attr.codimension)
+ tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank);
+ else
+ tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank);
gfc_add_expr_to_block (&fnblock, tmp);
}
@@ -7788,6 +7803,19 @@ gfc_deallocate_alloc_comp (gfc_symbol * der_type, tree decl, int rank)
/* Recursively traverse an object of derived type, generating code to
+ deallocate allocatable components. But do not deallocate coarrays.
+ To be used for intrinsic assignment, which may not change the allocation
+ status of coarrays. */
+
+tree
+gfc_deallocate_alloc_comp_no_caf (gfc_symbol * der_type, tree decl, int rank)
+{
+ return structure_alloc_comps (der_type, decl, NULL_TREE, rank,
+ DEALLOCATE_ALLOC_COMP_NO_CAF);
+}
+
+
+/* Recursively traverse an object of derived type, generating code to
copy it and its allocatable components. */
tree
@@ -8220,8 +8248,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
if ((expr1->ts.type == BT_DERIVED)
&& expr1->ts.u.derived->attr.alloc_comp)
{
- tmp = gfc_deallocate_alloc_comp (expr1->ts.u.derived, old_desc,
- expr1->rank);
+ tmp = gfc_deallocate_alloc_comp_no_caf (expr1->ts.u.derived, old_desc,
+ expr1->rank);
gfc_add_expr_to_block (&realloc_block, tmp);
}
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 8d9e461..285277f 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -51,6 +51,7 @@ tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank);
tree gfc_nullify_alloc_comp (gfc_symbol *, tree, int);
tree gfc_deallocate_alloc_comp (gfc_symbol *, tree, int);
+tree gfc_deallocate_alloc_comp_no_caf (gfc_symbol *, tree, int);
tree gfc_copy_alloc_comp (gfc_symbol *, tree, tree, int);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 56dc766..4d125a7 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6842,7 +6842,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
if (!l_is_temp && dealloc)
{
tmp = gfc_evaluate_now (lse->expr, &lse->pre);
- tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0);
+ tmp = gfc_deallocate_alloc_comp_no_caf (ts.u.derived, tmp, 0);
if (deep_copy)
tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
tmp);
@@ -7196,8 +7196,8 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
&& expr1->ts.u.derived->attr.alloc_comp)
{
tree tmp;
- tmp = gfc_deallocate_alloc_comp (expr1->ts.u.derived, se.expr,
- expr1->rank);
+ tmp = gfc_deallocate_alloc_comp_no_caf (expr1->ts.u.derived, se.expr,
+ expr1->rank);
gfc_add_expr_to_block (&se.pre, tmp);
}
@@ -7762,7 +7762,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
&& expr1->rank && !expr2->rank);
if (scalar_to_array && dealloc)
{
- tmp = gfc_deallocate_alloc_comp (expr2->ts.u.derived, rse.expr, 0);
+ tmp = gfc_deallocate_alloc_comp_no_caf (expr2->ts.u.derived, rse.expr, 0);
gfc_add_expr_to_block (&loop.post, tmp);
}
--- /dev/null 2013-06-22 16:49:36.543138847 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lib_realloc_1.f90 2013-06-22 20:12:27.237377267 +0200
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+! Test that for CAF components _gfortran_caf_deregister is called
+! Test that norealloc happens for CAF components during assignment
+!
+module m
+type t
+ integer, allocatable :: CAF[:]
+ integer, allocatable :: ii
+end type t
+end module m
+
+subroutine foo()
+use m
+type(t) :: x,y
+if (allocated(x%caf)) call abort()
+x = y
+end
+
+! For comp%ii: End of scope of x + y (2x) and for the LHS of the assignment (1x)
+! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } }
+
+! For comp%CAF: End of scope of x + y (2x); no LHS freeing for the CAF in assignment
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister" 2 "original" } }
+
+! Only malloc "ii":
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 1 "original" } }
+
+! But copy "ii" and "CAF":
+! { dg-final { scan-tree-dump-times "__builtin_memcpy" 2 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, Fortran] Coarrays: Don't (free)/alloc LHS coarray components on assignment
2013-06-22 18:19 [Patch, Fortran] Coarrays: Don't (free)/alloc LHS coarray components on assignment Tobias Burnus
@ 2013-06-26 21:00 ` Tobias Burnus
2013-07-16 16:37 ` Tejas Belagod
0 siblings, 1 reply; 4+ messages in thread
From: Tobias Burnus @ 2013-06-26 21:00 UTC (permalink / raw)
To: gcc patches, gfortran
[-- Attachment #1: Type: text/plain, Size: 1169 bytes --]
Tobias Burnus wrote:
> With coarrays, allocation/deallocation of coarrays requires a
> synchronization with all other images. Thus, the standard restricts
> changing the allocation status to: ALLOCATE and DEALLOCATE statements
> plus end-of-scope deallocation.
>
> In particular, with intrinsic assignment the allocation status does
> not change. Hence, there is no realloc on assignment. But also (this
> patch!) no deallocation/allocation of allocatable components during
> intrinsic assignment of derived types. [This implies that the LHS
> componet has to have the same allocation status, shape,
> type-parameters and actual type as the RHS.]
>
> The patch additionally checks whether end-of-scope deallocation of
> coarrays properly calls the deregister function (it did/does).
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
Update: I forgot to copy the back the address of the allocated CAF -
which lead to an unwanted address sharing between the RHS and LHS.
Note: structure_alloc_comps also contains bits from
http://gcc.gnu.org/ml/fortran/2013-06/msg00131.html
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
[-- Attachment #2: caf_norealloc-v2.diff --]
[-- Type: text/x-patch, Size: 15142 bytes --]
2013-06-26 Tobias Burnus <burnus@net-b.de>
* trans-array.h (gfc_deallocate_alloc_comp_no_caf,
gfc_reassign_alloc_comp_caf): New prototype.
* trans-array.c (enum): Add DEALLOCATE_ALLOC_COMP_NO_CAF
and COPY_ALLOC_COMP_CAF.
(structure_alloc_comps): Handle it.
(gfc_reassign_alloc_comp_caf,
gfc_deallocate_alloc_comp_no_caf): New function.
(gfc_alloc_allocatable_for_assignment): Call it.
* trans-expr.c (gfc_trans_scalar_assign,
gfc_trans_arrayfunc_assign, gfc_trans_assignment_1): Ditto.
* parse.c (parse_derived): Correctly set coarray_comp.
* resolve.c (resolve_symbol): Improve error wording.
2013-06-26 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray_lib_realloc_1.f90: New.
* gfortran.dg/coarray/lib_realloc_1.f90: New.
* gfortran.dg/coarray_6.f90: Add dg-error.
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index f98a213..737f3d6 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2228,11 +2228,11 @@ endType:
sym->attr.coarray_comp = 1;
}
- if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp)
+ if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp
+ && !c->attr.pointer)
{
coarray = true;
- if (!pointer && !allocatable)
- sym->attr.coarray_comp = 1;
+ sym->attr.coarray_comp = 1;
}
/* Looking for lock_type components. */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index ce68401..0c0804b 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -13125,8 +13125,8 @@ resolve_symbol (gfc_symbol *sym)
&& (class_attr.codimension || class_attr.pointer || class_attr.dimension
|| class_attr.allocatable))
{
- gfc_error ("Variable '%s' at %L with coarray component "
- "shall be a nonpointer, nonallocatable scalar",
+ gfc_error ("Variable '%s' at %L with coarray component shall be a "
+ "nonpointer, nonallocatable scalar, which is not a coarray",
sym->name, &sym->declared_at);
return;
}
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 39bf0dd..452becf 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7445,8 +7445,9 @@ gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank)
deallocate, nullify or copy allocatable components. This is the work horse
function for the functions named in this enum. */
-enum {DEALLOCATE_ALLOC_COMP = 1, NULLIFY_ALLOC_COMP, COPY_ALLOC_COMP,
- COPY_ONLY_ALLOC_COMP};
+enum {DEALLOCATE_ALLOC_COMP = 1, DEALLOCATE_ALLOC_COMP_NO_CAF,
+ NULLIFY_ALLOC_COMP, COPY_ALLOC_COMP, COPY_ONLY_ALLOC_COMP,
+ COPY_ALLOC_COMP_CAF};
static tree
structure_alloc_comps (gfc_symbol * der_type, tree decl,
@@ -7577,6 +7578,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
switch (purpose)
{
case DEALLOCATE_ALLOC_COMP:
+ case DEALLOCATE_ALLOC_COMP_NO_CAF:
/* gfc_deallocate_scalar_with_status calls gfc_deallocate_alloc_comp
(i.e. this function) so generate all the calls and suppress the
@@ -7584,19 +7586,37 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
called_dealloc_with_status = false;
gfc_init_block (&tmpblock);
- if (c->attr.allocatable && (c->attr.dimension || c->attr.codimension)
- && !c->attr.proc_pointer)
+ if ((c->ts.type == BT_DERIVED && !c->attr.pointer)
+ || (c->ts.type == BT_CLASS && !CLASS_DATA (c)->attr.class_pointer))
{
comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
decl, cdecl, NULL_TREE);
+
+ /* The finalizer frees allocatable components. */
+ called_dealloc_with_status
+ = gfc_add_comp_finalizer_call (&tmpblock, comp, c,
+ purpose == DEALLOCATE_ALLOC_COMP);
+ }
+ else
+ comp = NULL_TREE;
+
+ if (c->attr.allocatable && !c->attr.proc_pointer
+ && (c->attr.dimension
+ || (c->attr.codimension
+ && purpose != DEALLOCATE_ALLOC_COMP_NO_CAF)))
+ {
+ if (comp == NULL_TREE)
+ comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+ decl, cdecl, NULL_TREE);
tmp = gfc_trans_dealloc_allocated (comp, c->attr.codimension, NULL);
gfc_add_expr_to_block (&tmpblock, tmp);
}
- else if (c->attr.allocatable)
+ else if (c->attr.allocatable && !c->attr.codimension)
{
/* Allocatable scalar components. */
- comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
- decl, cdecl, NULL_TREE);
+ if (comp == NULL_TREE)
+ comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+ decl, cdecl, NULL_TREE);
tmp = gfc_deallocate_scalar_with_status (comp, NULL, true, NULL,
c->ts);
@@ -7608,13 +7628,16 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
build_int_cst (TREE_TYPE (comp), 0));
gfc_add_expr_to_block (&tmpblock, tmp);
}
- else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
+ else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable
+ && (!CLASS_DATA (c)->attr.codimension
+ || purpose != DEALLOCATE_ALLOC_COMP_NO_CAF))
{
/* Allocatable CLASS components. */
- comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
- decl, cdecl, NULL_TREE);
/* Add reference to '_data' component. */
+ if (comp == NULL_TREE)
+ comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+ decl, cdecl, NULL_TREE);
tmp = CLASS_DATA (c)->backend_decl;
comp = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (tmp), comp, tmp, NULL_TREE);
@@ -7705,6 +7728,28 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
}
break;
+ case COPY_ALLOC_COMP_CAF:
+ if (!c->attr.codimension
+ && (c->ts.type != BT_CLASS || CLASS_DATA (c)->attr.coarray_comp)
+ && (c->ts.type != BT_DERIVED
+ || !c->ts.u.derived->attr.coarray_comp))
+ continue;
+
+ comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl,
+ cdecl, NULL_TREE);
+ dcmp = fold_build3_loc (input_location, COMPONENT_REF, ctype, dest,
+ cdecl, NULL_TREE);
+ if (c->attr.codimension)
+ gfc_add_modify (&fnblock, dcmp, comp);
+ else
+ {
+ tmp = structure_alloc_comps (c->ts.u.derived, comp, dcmp,
+ rank, purpose);
+ gfc_add_expr_to_block (&fnblock, tmp);
+
+ }
+ break;
+
case COPY_ALLOC_COMP:
if (c->attr.pointer)
continue;
@@ -7736,18 +7781,30 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
size_type_node, size,
fold_convert (size_type_node,
nelems));
- src_data = gfc_conv_descriptor_data_get (src_data);
- dst_data = gfc_conv_descriptor_data_get (dst_data);
}
else
nelems = build_int_cst (size_type_node, 1);
+ if (CLASS_DATA (c)->attr.dimension
+ || CLASS_DATA (c)->attr.codimension)
+ {
+ src_data = gfc_conv_descriptor_data_get (src_data);
+ dst_data = gfc_conv_descriptor_data_get (dst_data);
+ }
+
gfc_init_block (&tmpblock);
- ftn_tree = builtin_decl_explicit (BUILT_IN_MALLOC);
- tmp = build_call_expr_loc (input_location, ftn_tree, 1, size);
- gfc_add_modify (&tmpblock, dst_data,
- fold_convert (TREE_TYPE (dst_data), tmp));
+ /* Coarray component have to have the same allocation status and
+ shape/type-parameter/effective-type on the LHS and RHS of an
+ intrinsic assignment. Hence, we did not deallocated them - and
+ do not allocate them here. */
+ if (!CLASS_DATA (c)->attr.codimension)
+ {
+ ftn_tree = builtin_decl_explicit (BUILT_IN_MALLOC);
+ tmp = build_call_expr_loc (input_location, ftn_tree, 1, size);
+ gfc_add_modify (&tmpblock, dst_data,
+ fold_convert (TREE_TYPE (dst_data), tmp));
+ }
tmp = gfc_copy_class_to_class (comp, dcmp, nelems);
gfc_add_expr_to_block (&tmpblock, tmp);
@@ -7772,7 +7829,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
&& !cmp_has_alloc_comps)
{
rank = c->as ? c->as->rank : 0;
- tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank);
+ if (c->attr.codimension)
+ tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank);
+ else
+ tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank);
gfc_add_expr_to_block (&fnblock, tmp);
}
@@ -7819,6 +7879,26 @@ gfc_deallocate_alloc_comp (gfc_symbol * der_type, tree decl, int rank)
/* Recursively traverse an object of derived type, generating code to
+ deallocate allocatable components. But do not deallocate coarrays.
+ To be used for intrinsic assignment, which may not change the allocation
+ status of coarrays. */
+
+tree
+gfc_deallocate_alloc_comp_no_caf (gfc_symbol * der_type, tree decl, int rank)
+{
+ return structure_alloc_comps (der_type, decl, NULL_TREE, rank,
+ DEALLOCATE_ALLOC_COMP_NO_CAF);
+}
+
+
+tree
+gfc_reassign_alloc_comp_caf (gfc_symbol *der_type, tree decl, tree dest)
+{
+ return structure_alloc_comps (der_type, decl, dest, 0, COPY_ALLOC_COMP_CAF);
+}
+
+
+/* Recursively traverse an object of derived type, generating code to
copy it and its allocatable components. */
tree
@@ -8251,8 +8331,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
if ((expr1->ts.type == BT_DERIVED)
&& expr1->ts.u.derived->attr.alloc_comp)
{
- tmp = gfc_deallocate_alloc_comp (expr1->ts.u.derived, old_desc,
- expr1->rank);
+ tmp = gfc_deallocate_alloc_comp_no_caf (expr1->ts.u.derived, old_desc,
+ expr1->rank);
gfc_add_expr_to_block (&realloc_block, tmp);
}
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 2d2b45d..e8f207e 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -51,6 +51,8 @@ tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank);
tree gfc_nullify_alloc_comp (gfc_symbol *, tree, int);
tree gfc_deallocate_alloc_comp (gfc_symbol *, tree, int);
+tree gfc_deallocate_alloc_comp_no_caf (gfc_symbol *, tree, int);
+tree gfc_reassign_alloc_comp_caf (gfc_symbol *, tree, tree);
tree gfc_copy_alloc_comp (gfc_symbol *, tree, tree, int);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 0eef2b2..e1ed9d9 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6824,6 +6824,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
}
else if (ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp)
{
+ tree tmp_var = NULL_TREE;
cond = NULL_TREE;
/* Are the rhs and the lhs the same? */
@@ -6841,8 +6842,8 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
expression. */
if (!l_is_temp && dealloc)
{
- tmp = gfc_evaluate_now (lse->expr, &lse->pre);
- tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0);
+ tmp_var = gfc_evaluate_now (lse->expr, &lse->pre);
+ tmp = gfc_deallocate_alloc_comp_no_caf (ts.u.derived, tmp_var, 0);
if (deep_copy)
tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
tmp);
@@ -6855,6 +6856,16 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
gfc_add_modify (&block, lse->expr,
fold_convert (TREE_TYPE (lse->expr), rse->expr));
+ /* Restore pointer address of coarray components. */
+ if (ts.u.derived->attr.coarray_comp && deep_copy)
+ {
+ gcc_assert (tmp_var != NULL_TREE);
+ tmp = gfc_reassign_alloc_comp_caf (ts.u.derived, tmp_var, lse->expr);
+ tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
+ tmp);
+ gfc_add_expr_to_block (&block, tmp);
+ }
+
/* Do a deep copy if the rhs is a variable, if it is not the
same as the lhs. */
if (deep_copy)
@@ -7196,8 +7207,8 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
&& expr1->ts.u.derived->attr.alloc_comp)
{
tree tmp;
- tmp = gfc_deallocate_alloc_comp (expr1->ts.u.derived, se.expr,
- expr1->rank);
+ tmp = gfc_deallocate_alloc_comp_no_caf (expr1->ts.u.derived, se.expr,
+ expr1->rank);
gfc_add_expr_to_block (&se.pre, tmp);
}
@@ -7762,7 +7773,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
&& expr1->rank && !expr2->rank);
if (scalar_to_array && dealloc)
{
- tmp = gfc_deallocate_alloc_comp (expr2->ts.u.derived, rse.expr, 0);
+ tmp = gfc_deallocate_alloc_comp_no_caf (expr2->ts.u.derived, rse.expr, 0);
gfc_add_expr_to_block (&loop.post, tmp);
}
--- /dev/null 2013-06-26 08:23:53.976189029 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lib_realloc_1.f90 2013-06-26 19:28:32.786634679 +0200
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+! PR fortran/52052
+!
+! Test that for CAF components _gfortran_caf_deregister is called
+! Test that norealloc happens for CAF components during assignment
+!
+module m
+type t
+ integer, allocatable :: CAF[:]
+ integer, allocatable :: ii
+end type t
+end module m
+
+subroutine foo()
+use m
+type(t) :: x,y
+if (allocated(x%caf)) call abort()
+x = y
+end
+
+! For comp%ii: End of scope of x + y (2x) and for the LHS of the assignment (1x)
+! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } }
+
+! For comp%CAF: End of scope of x + y (2x); no LHS freeing for the CAF in assignment
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister" 2 "original" } }
+
+! Only malloc "ii":
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 1 "original" } }
+
+! But copy "ii" and "CAF":
+! { dg-final { scan-tree-dump-times "__builtin_memcpy" 2 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
--- /dev/null 2013-06-26 08:23:53.976189029 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray/lib_realloc_1.f90 2013-06-26 19:57:48.418908565 +0200
@@ -0,0 +1,30 @@
+! { dg-do run }
+! { dg-options "-O0" }
+!
+! Test that for CAF components _gfortran_caf_deregister is called
+! Test that norealloc happens for CAF components during assignment
+!
+module m
+type t
+ integer, allocatable :: CAF[:]
+end type t
+end module m
+
+program main
+use m
+type(t), target :: x,y
+integer, pointer :: ptr
+allocate(x%caf[*], y%caf[*])
+ptr => y%caf
+ptr = 6
+if (.not.allocated(x%caf)) call abort()
+if (.not.allocated(y%caf)) call abort()
+if (y%caf /= 6) call abort ()
+x = y
+if (x%caf /= 6) call abort ()
+if (.not. associated (ptr,y%caf)) call abort()
+if (associated (ptr,x%caf)) call abort()
+ptr = 123
+if (y%caf /= 123) call abort ()
+if (x%caf /= 6) call abort ()
+end program main
diff --git a/gcc/testsuite/gfortran.dg/coarray_6.f90 b/gcc/testsuite/gfortran.dg/coarray_6.f90
index 9fb06d4..f44ac01 100644
--- a/gcc/testsuite/gfortran.dg/coarray_6.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_6.f90
@@ -75,7 +75,7 @@ subroutine valid(a)
type t2
type(t) :: b
end type t2
- type(t2), save :: xt2[*]
+ type(t2), save :: xt2[*] ! { dg-error "nonpointer, nonallocatable scalar, which is not a coarray" }
end subroutine valid
program main
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, Fortran] Coarrays: Don't (free)/alloc LHS coarray components on assignment
2013-06-26 21:00 ` Tobias Burnus
@ 2013-07-16 16:37 ` Tejas Belagod
2013-07-16 21:07 ` Tobias Burnus
0 siblings, 1 reply; 4+ messages in thread
From: Tejas Belagod @ 2013-07-16 16:37 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc patches, gfortran
Tobias Burnus wrote:
> Tobias Burnus wrote:
>> With coarrays, allocation/deallocation of coarrays requires a
>> synchronization with all other images. Thus, the standard restricts
>> changing the allocation status to: ALLOCATE and DEALLOCATE statements
>> plus end-of-scope deallocation.
>>
>> In particular, with intrinsic assignment the allocation status does
>> not change. Hence, there is no realloc on assignment. But also (this
>> patch!) no deallocation/allocation of allocatable components during
>> intrinsic assignment of derived types. [This implies that the LHS
>> componet has to have the same allocation status, shape,
>> type-parameters and actual type as the RHS.]
>>
>> The patch additionally checks whether end-of-scope deallocation of
>> coarrays properly calls the deregister function (it did/does).
>>
>> Build and regtested on x86-64-gnu-linux.
>> OK for the trunk?
>
> Update: I forgot to copy the back the address of the allocated CAF -
> which lead to an unwanted address sharing between the RHS and LHS.
>
> Note: structure_alloc_comps also contains bits from
> http://gcc.gnu.org/ml/fortran/2013-06/msg00131.html
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
>
> Tobias
>
2013-06-26 Tobias Burnus <burnus@net-b.de>
* trans-array.h (gfc_deallocate_alloc_comp_no_caf,
gfc_reassign_alloc_comp_caf): New prototype.
* trans-array.c (enum): Add DEALLOCATE_ALLOC_COMP_NO_CAF
and COPY_ALLOC_COMP_CAF.
(structure_alloc_comps): Handle it.
(gfc_reassign_alloc_comp_caf,
gfc_deallocate_alloc_comp_no_caf): New function.
(gfc_alloc_allocatable_for_assignment): Call it.
* trans-expr.c (gfc_trans_scalar_assign,
gfc_trans_arrayfunc_assign, gfc_trans_assignment_1): Ditto.
* parse.c (parse_derived): Correctly set coarray_comp.
* resolve.c (resolve_symbol): Improve error wording.
2013-06-26 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray_lib_realloc_1.f90: New.
* gfortran.dg/coarray/lib_realloc_1.f90: New.
* gfortran.dg/coarray_6.f90: Add dg-error.
Hi,
I observed that this patch causes an ICE with one of the fortran tests. I've
filed a bug report here: http://gcc.gnu.org/bugzilla/show_bug.cgi?id=57912.
Thanks,
Tejas Belagod.
ARM.
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, Fortran] Coarrays: Don't (free)/alloc LHS coarray components on assignment
2013-07-16 16:37 ` Tejas Belagod
@ 2013-07-16 21:07 ` Tobias Burnus
0 siblings, 0 replies; 4+ messages in thread
From: Tobias Burnus @ 2013-07-16 21:07 UTC (permalink / raw)
To: Tejas Belagod; +Cc: gcc patches, gfortran
[-- Attachment #1: Type: text/plain, Size: 1137 bytes --]
Tejas Belagod wrote:
> I observed that this patch causes an ICE with one of the fortran
> tests. I've filed a bug report here:
> http://gcc.gnu.org/bugzilla/show_bug.cgi?id=57912.
Thanks for the report! For some reason, the following bit from my local
tree didn't end up in the patch. Committed as Rev. 200987.
Tobias
PS: Your backtrace in the PR looks odd; I get the following (also on
x86-64-gnu-linux), which is much more reasonable. I wonder why yours is off.
0x5fb0ee gfc_trans_scalar_assign(gfc_se*, gfc_se*, gfc_typespec, bool,
bool, bool)
../../gcc/fortran/trans-expr.c:6862
0x606e62 gfc_trans_assignment_1
../../gcc/fortran/trans-expr.c:7792
0x5cb565 trans_code
../../gcc/fortran/trans.c:1646
0x5f434e gfc_generate_function_code(gfc_namespace*)
../../gcc/fortran/trans-decl.c:5524
0x5ccef1 gfc_generate_module_code(gfc_namespace*)
../../gcc/fortran/trans.c:1955
0x58b147 translate_all_program_units
../../gcc/fortran/parse.c:4496
0x58b147 gfc_parse_file()
../../gcc/fortran/parse.c:4706
0x5c7205 gfc_be_parse_file
../../gcc/fortran/f95-lang.c:189
[-- Attachment #2: commit.diff --]
[-- Type: text/x-patch, Size: 1175 bytes --]
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 200986)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,9 @@
+2013-07-16 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/57912
+ * trans-expr.c (gfc_trans_scalar_assign): Correct if
+ condition for caf realloc.
+
2013-07-15 Tobias Burnus <burnus@net-b.de>
* trans-array.h (gfc_deallocate_alloc_comp_no_caf,
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 200986)
+++ gcc/fortran/trans-expr.c (Arbeitskopie)
@@ -6857,9 +6857,8 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rs
fold_convert (TREE_TYPE (lse->expr), rse->expr));
/* Restore pointer address of coarray components. */
- if (ts.u.derived->attr.coarray_comp && deep_copy)
+ if (ts.u.derived->attr.coarray_comp && deep_copy && tmp_var != NULL_TREE)
{
- gcc_assert (tmp_var != NULL_TREE);
tmp = gfc_reassign_alloc_comp_caf (ts.u.derived, tmp_var, lse->expr);
tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
tmp);
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2013-07-16 20:58 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-06-22 18:19 [Patch, Fortran] Coarrays: Don't (free)/alloc LHS coarray components on assignment Tobias Burnus
2013-06-26 21:00 ` Tobias Burnus
2013-07-16 16:37 ` Tejas Belagod
2013-07-16 21:07 ` Tobias Burnus
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).