From: Andre Vehreschild Date: Wed, 18 Jan 2017 19:03:21 +0000 (+0100) Subject: coarray_alloc_with_implicit_sync_2.f90: New test. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=525a5e33b5c7baafd44ce91b4064148e99b4e97e;p=gcc.git coarray_alloc_with_implicit_sync_2.f90: New test. gcc/testsuite/ChangeLog: 2017-01-18 Andre Vehreschild * 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 * 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8bca98852fc..0c59ced7c77 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2017-01-18 Andre Vehreschild + + * 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 * gfortran.texi: Add missing parameters to caf-API functions. Correct diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index d62f6bb1818..02e6dc17415 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2449,7 +2449,7 @@ caf_variable_attr (gfc_expr *expr, bool in_allocate, bool *refs_comp) gfc_clear_attr (&attr); if (refs_comp) - *refs_comp = 0; + *refs_comp = false; 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) allocatable = comp->attr.allocatable; } - if (refs_comp && strcmp (comp->name, "_data") != 0) - *refs_comp = 1; + if (refs_comp && strcmp (comp->name, "_data") != 0 + && (ref->next == NULL + || (ref->next->type == REF_ARRAY && ref->next->next == NULL))) + *refs_comp = true; if (pointer || attr.proc_pointer) target = 1; diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 856008779ba..63f33049842 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -5506,8 +5506,10 @@ gfc_trans_allocate (gfc_code * code) stmtblock_t block; stmtblock_t post; 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; + symbol_attribute caf_attr; if (!code->ext.alloc.list) return NULL_TREE; @@ -5516,7 +5518,7 @@ gfc_trans_allocate (gfc_code * code) expr3 = expr3_vptr = expr3_len = expr3_esize = NULL_TREE; label_errmsg = label_finish = errmsg = errlen = NULL_TREE; e3_is = E3_UNSET; - is_coarray = false; + is_coarray = needs_caf_sync = false; gfc_init_block (&block); gfc_init_block (&post); @@ -6087,16 +6089,20 @@ gfc_trans_allocate (gfc_code * code) /* Handle size computation of the type declared to alloc. */ memsz = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr))); - if (gfc_caf_attr (expr).codimension - && flag_coarray == GFC_FCOARRAY_LIB) + /* Store the caf-attributes for latter use. */ + 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 it here and are treated now. */ tree caf_decl, token; gfc_se caf_se; - /* Set flag, to add synchronize after the allocate. */ 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); @@ -6121,8 +6127,14 @@ gfc_trans_allocate (gfc_code * code) { /* Allocating coarrays needs a sync after the allocate executed. Set the flag to add the sync after all objects are allocated. */ - is_coarray = is_coarray || (gfc_caf_attr (expr).codimension - && flag_coarray == GFC_FCOARRAY_LIB); + if (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 && expr3_len != NULL_TREE) @@ -6401,7 +6413,7 @@ gfc_trans_allocate (gfc_code * code) 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. */ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 01e71827258..974f9ffaaaa 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,4 +1,8 @@ -2017-01-17 Andre Vehreschild +2017-01-18 Andre Vehreschild + + * gfortran.dg/coarray_alloc_with_implicit_sync_2.f90: New test. + +2017-01-18 Andre Vehreschild PR fortran/70696 * gfortran.dg/coarray_event_1.f08: New test. diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_with_implicit_sync_2.f90 b/gcc/testsuite/gfortran.dg/coarray_alloc_with_implicit_sync_2.f90 new file mode 100644 index 00000000000..eccfde37f82 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_alloc_with_implicit_sync_2.f90 @@ -0,0 +1,30 @@ +! { 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" } }