Commit 525a5e33 by Andre Vehreschild

coarray_alloc_with_implicit_sync_2.f90: New test.

gcc/testsuite/ChangeLog:

2017-01-18  Andre Vehreschild  <vehre@gcc.gnu.org>

	* gfortran.dg/coarray_alloc_with_implicit_sync_2.f90: New test.

Also fixed date in gcc/testsuite/ChangeLog on my previous commit.

gcc/fortran/ChangeLog:

2017-01-18  Andre Vehreschild  <vehre@gcc.gnu.org>

	* primary.c (caf_variable_attr): Improve figuring whether the current
	component is the last one refed.
	* trans-stmt.c (gfc_trans_allocate): Do not generate sync_all calls
	when allocating pointer or allocatable components.

From-SVN: r244590
parent 29dbb95a
2017-01-18 Andre Vehreschild <vehre@gcc.gnu.org> 2017-01-18 Andre Vehreschild <vehre@gcc.gnu.org>
* primary.c (caf_variable_attr): Improve figuring whether the current
component is the last one refed.
* trans-stmt.c (gfc_trans_allocate): Do not generate sync_all calls
when allocating pointer or allocatable components.
2017-01-18 Andre Vehreschild <vehre@gcc.gnu.org>
* gfortran.texi: Add missing parameters to caf-API functions. Correct * gfortran.texi: Add missing parameters to caf-API functions. Correct
typos and clarify some descriptions. typos and clarify some descriptions.
......
...@@ -2449,7 +2449,7 @@ caf_variable_attr (gfc_expr *expr, bool in_allocate, bool *refs_comp) ...@@ -2449,7 +2449,7 @@ caf_variable_attr (gfc_expr *expr, bool in_allocate, bool *refs_comp)
gfc_clear_attr (&attr); gfc_clear_attr (&attr);
if (refs_comp) if (refs_comp)
*refs_comp = 0; *refs_comp = false;
if (sym->ts.type == BT_CLASS && sym->attr.class_ok) if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
{ {
...@@ -2527,8 +2527,10 @@ caf_variable_attr (gfc_expr *expr, bool in_allocate, bool *refs_comp) ...@@ -2527,8 +2527,10 @@ caf_variable_attr (gfc_expr *expr, bool in_allocate, bool *refs_comp)
allocatable = comp->attr.allocatable; allocatable = comp->attr.allocatable;
} }
if (refs_comp && strcmp (comp->name, "_data") != 0) if (refs_comp && strcmp (comp->name, "_data") != 0
*refs_comp = 1; && (ref->next == NULL
|| (ref->next->type == REF_ARRAY && ref->next->next == NULL)))
*refs_comp = true;
if (pointer || attr.proc_pointer) if (pointer || attr.proc_pointer)
target = 1; target = 1;
......
...@@ -5506,8 +5506,10 @@ gfc_trans_allocate (gfc_code * code) ...@@ -5506,8 +5506,10 @@ gfc_trans_allocate (gfc_code * code)
stmtblock_t block; stmtblock_t block;
stmtblock_t post; stmtblock_t post;
tree nelems; tree nelems;
bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set, is_coarray ; bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set, is_coarray;
bool needs_caf_sync, caf_refs_comp;
gfc_symtree *newsym = NULL; gfc_symtree *newsym = NULL;
symbol_attribute caf_attr;
if (!code->ext.alloc.list) if (!code->ext.alloc.list)
return NULL_TREE; return NULL_TREE;
...@@ -5516,7 +5518,7 @@ gfc_trans_allocate (gfc_code * code) ...@@ -5516,7 +5518,7 @@ gfc_trans_allocate (gfc_code * code)
expr3 = expr3_vptr = expr3_len = expr3_esize = NULL_TREE; expr3 = expr3_vptr = expr3_len = expr3_esize = NULL_TREE;
label_errmsg = label_finish = errmsg = errlen = NULL_TREE; label_errmsg = label_finish = errmsg = errlen = NULL_TREE;
e3_is = E3_UNSET; e3_is = E3_UNSET;
is_coarray = false; is_coarray = needs_caf_sync = false;
gfc_init_block (&block); gfc_init_block (&block);
gfc_init_block (&post); gfc_init_block (&post);
...@@ -6087,16 +6089,20 @@ gfc_trans_allocate (gfc_code * code) ...@@ -6087,16 +6089,20 @@ gfc_trans_allocate (gfc_code * code)
/* Handle size computation of the type declared to alloc. */ /* Handle size computation of the type declared to alloc. */
memsz = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr))); memsz = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
if (gfc_caf_attr (expr).codimension /* Store the caf-attributes for latter use. */
&& flag_coarray == GFC_FCOARRAY_LIB) if (flag_coarray == GFC_FCOARRAY_LIB
&& (caf_attr = gfc_caf_attr (expr, true, &caf_refs_comp))
.codimension)
{ {
/* Scalar allocatable components in coarray'ed derived types make /* Scalar allocatable components in coarray'ed derived types make
it here and are treated now. */ it here and are treated now. */
tree caf_decl, token; tree caf_decl, token;
gfc_se caf_se; gfc_se caf_se;
/* Set flag, to add synchronize after the allocate. */
is_coarray = true; is_coarray = true;
/* Set flag, to add synchronize after the allocate. */
needs_caf_sync = needs_caf_sync
|| caf_attr.coarray_comp || !caf_refs_comp;
gfc_init_se (&caf_se, NULL); gfc_init_se (&caf_se, NULL);
...@@ -6121,8 +6127,14 @@ gfc_trans_allocate (gfc_code * code) ...@@ -6121,8 +6127,14 @@ gfc_trans_allocate (gfc_code * code)
{ {
/* Allocating coarrays needs a sync after the allocate executed. /* Allocating coarrays needs a sync after the allocate executed.
Set the flag to add the sync after all objects are allocated. */ Set the flag to add the sync after all objects are allocated. */
is_coarray = is_coarray || (gfc_caf_attr (expr).codimension if (flag_coarray == GFC_FCOARRAY_LIB
&& flag_coarray == GFC_FCOARRAY_LIB); && (caf_attr = gfc_caf_attr (expr, true, &caf_refs_comp))
.codimension)
{
is_coarray = true;
needs_caf_sync = needs_caf_sync
|| caf_attr.coarray_comp || !caf_refs_comp;
}
if (expr->ts.type == BT_CHARACTER && al_len != NULL_TREE if (expr->ts.type == BT_CHARACTER && al_len != NULL_TREE
&& expr3_len != NULL_TREE) && expr3_len != NULL_TREE)
...@@ -6401,7 +6413,7 @@ gfc_trans_allocate (gfc_code * code) ...@@ -6401,7 +6413,7 @@ gfc_trans_allocate (gfc_code * code)
gfc_add_modify (&block, se.expr, tmp); gfc_add_modify (&block, se.expr, tmp);
} }
if (is_coarray && flag_coarray == GFC_FCOARRAY_LIB) if (needs_caf_sync)
{ {
/* Add a sync all after the allocation has been executed. */ /* Add a sync all after the allocation has been executed. */
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all, tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
......
2017-01-17 Andre Vehreschild <vehre@gcc.gnu.org> 2017-01-18 Andre Vehreschild <vehre@gcc.gnu.org>
* gfortran.dg/coarray_alloc_with_implicit_sync_2.f90: New test.
2017-01-18 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/70696 PR fortran/70696
* gfortran.dg/coarray_event_1.f08: New test. * gfortran.dg/coarray_event_1.f08: New test.
......
! { dg-do compile }
! { dg-options "-fcoarray=lib -fdump-tree-original" }
!
! Test that the compiler generates sync_all statements only at the required
! locations. This program is not supposed to run (allocating already alloced).
program test_alloc_sync
type :: T
integer, allocatable :: i
end type T
type :: T2
type(T), allocatable :: o[:]
end type T2
integer, allocatable :: caf[:]
type (T) :: obj[*]
type (T2) :: cafcomp
allocate(caf[*]) ! implicit sync_all
allocate(obj%i) ! asynchronous
allocate(cafcomp%o[*]) ! sync
allocate(cafcomp%o%i) ! async
allocate(obj%i, cafcomp%o%i) ! async
allocate(caf[*], obj%i, cafcomp%o%i) ! sync
end program test_alloc_sync
! { dg-final { scan-tree-dump-times "caf_sync_all" 3 "original" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment