From: Andre Vehreschild Date: Fri, 30 Sep 2016 10:20:59 +0000 (+0200) Subject: trans-array.c (gfc_array_allocate): Use the token from coarray's .token member. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=26f391e8067e96e4fba7b531eda9fb80023f2fd2;p=gcc.git trans-array.c (gfc_array_allocate): Use the token from coarray's .token member. gcc/fortran/ChangeLog: 2016-09-30 Andre Vehreschild * trans-array.c (gfc_array_allocate): Use the token from coarray's .token member. * trans-intrinsic.c (conv_expr_ref_to_caf_ref): Only generate caf-reference chains from the first coarray references on. * trans-types.c (gfc_get_derived_type): Switch on mandatory .token member generation for allocatable arrays in coarrays in derived types. gcc/testsuite/ChangeLog: 2016-09-30 Andre Vehreschild * gfortran.dg/coarray_allocate_10.f08: New test. * gfortran.dg/coindexed_1.f90: Above fixes allow execution. From-SVN: r240650 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 53fab3d8fc8..ea28ae55f93 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2016-09-30 Andre Vehreschild + + * trans-array.c (gfc_array_allocate): Use the token from coarray's + .token member. + * trans-intrinsic.c (conv_expr_ref_to_caf_ref): Only generate + caf-reference chains from the first coarray references on. + * trans-types.c (gfc_get_derived_type): Switch on mandatory .token + member generation for allocatable arrays in coarrays in derived types. + 2016-09-29 James Greenhalgh * options.c (gfc_post_options): Remove special case for diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0b977600940..50312fed307 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5406,7 +5406,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, gfc_expr **lower; gfc_expr **upper; gfc_ref *ref, *prev_ref = NULL, *coref; - gfc_se caf_se; bool allocatable, coarray, dimension, alloc_w_e3_arr_spec = false; ref = expr->ref; @@ -5531,7 +5530,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, } } - gfc_init_se (&caf_se, NULL); gfc_start_block (&elseblock); /* Allocate memory to store the data. */ @@ -5543,9 +5541,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, if (coarray && flag_coarray == GFC_FCOARRAY_LIB) { - tmp = gfc_get_tree_for_caf_expr (expr); - gfc_get_caf_token_offset (&caf_se, &token, NULL, tmp, NULL_TREE, expr); - gfc_add_block_to_block (&elseblock, &caf_se.pre); + token = gfc_conv_descriptor_token (se->expr); token = gfc_build_addr_expr (NULL_TREE, token); } @@ -5557,7 +5553,6 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, else gfc_allocate_using_malloc (&elseblock, pointer, size, status); - gfc_add_block_to_block (&elseblock, &caf_se.post); if (dimension) { cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 954f7b3afd4..a499c327386 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1110,7 +1110,7 @@ compute_component_offset (tree field, tree type) static tree conv_expr_ref_to_caf_ref (stmtblock_t *block, gfc_expr *expr) { - gfc_ref *ref = expr->ref; + gfc_ref *ref = expr->ref, *last_comp_ref; tree caf_ref = NULL_TREE, prev_caf_ref = NULL_TREE, reference_type, tmp, tmp2, field, last_type, inner_struct, mode, mode_rhs, dim_array, dim, dim_type, start, end, stride, vector, nvec; @@ -1127,8 +1127,29 @@ conv_expr_ref_to_caf_ref (stmtblock_t *block, gfc_expr *expr) /* Prevent uninit-warning. */ reference_type = NULL_TREE; - last_type = gfc_typenode_for_spec (&expr->symtree->n.sym->ts); - last_type_n = expr->symtree->n.sym->ts.type; + + /* Skip refs upto the first coarray-ref. */ + last_comp_ref = NULL; + while (ref && (ref->type != REF_ARRAY || ref->u.ar.codimen == 0)) + { + /* Remember the type of components skipped. */ + if (ref->type == REF_COMPONENT) + last_comp_ref = ref; + ref = ref->next; + } + /* When a component was skipped, get the type information of the last + component ref, else get the type from the symbol. */ + if (last_comp_ref) + { + last_type = gfc_typenode_for_spec (&last_comp_ref->u.c.component->ts); + last_type_n = last_comp_ref->u.c.component->ts.type; + } + else + { + last_type = gfc_typenode_for_spec (&expr->symtree->n.sym->ts); + last_type_n = expr->symtree->n.sym->ts.type; + } + while (ref) { if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0 diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 27a6bab7a05..05122d90616 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2565,7 +2565,8 @@ gfc_get_derived_type (gfc_symbol * derived, bool in_coarray) if ((!c->attr.pointer && !c->attr.proc_pointer) || c->ts.u.derived->backend_decl == NULL) c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived, - in_coarray); + in_coarray + || c->attr.codimension); if (c->ts.u.derived->attr.is_iso_c) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 11fc7a8de85..9e8204174bc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2016-09-30 Andre Vehreschild + + * gfortran.dg/coarray_allocate_10.f08: New test. + * gfortran.dg/coindexed_1.f90: Above fixes allow execution. + 2016-09-30 Kyrylo Tkachov * gcc.target/aarch64/ifcvt_avoid_const_materialization_1.c: New test. diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_10.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_10.f08 new file mode 100644 index 00000000000..30ee216af04 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_allocate_10.f08 @@ -0,0 +1,39 @@ +! { dg-do run } +! { dg-options "-fcoarray=lib -lcaf_single" } + +program alloc_comp + implicit none + + type coords + integer,allocatable :: x(:) + end type + + type outerT + type(coords),allocatable :: coo[:] + end type + integer :: me,np,n,i + type(outerT) :: o + + ! with caf_single num_images is always == 1 + me = this_image(); np = num_images() + n = 100 + + allocate(o%coo[*]) + allocate(o%coo%x(n)) + + o%coo%x = me + + do i=1, n + o%coo%x(i) = o%coo%x(i) + i + end do + + sync all + + if(me == 1 .and. o%coo[np]%x(10) /= 11 ) call abort() + + ! Check the whole array is correct. + if (me == 1 .and. any( o%coo[np]%x /= [(i, i=2, 101)] ) ) call abort() + + deallocate(o%coo%x) + +end program diff --git a/gcc/testsuite/gfortran.dg/coindexed_1.f90 b/gcc/testsuite/gfortran.dg/coindexed_1.f90 index b25f2f83d23..932442c4b32 100644 --- a/gcc/testsuite/gfortran.dg/coindexed_1.f90 +++ b/gcc/testsuite/gfortran.dg/coindexed_1.f90 @@ -1,5 +1,5 @@ -! { dg-do compile } -! { dg-options "-fcoarray=lib" } +! { dg-do run } +! { dg-options "-fcoarray=lib -lcaf_single" } ! ! Contributed by Reinhold Bader ! @@ -14,7 +14,7 @@ program pmup integer :: ii !! --- ONE --- - allocate(real :: a(3)[*]) ! { dg-error "Sorry, coindexed access to an unlimited polymorphic object at" } + allocate(real :: a(3)[*]) IF (this_image() == num_images()) THEN SELECT TYPE (a) TYPE IS (real) @@ -43,7 +43,7 @@ program pmup !! --- TWO --- deallocate(a) - allocate(t :: a(3)[*]) ! { dg-error "Sorry, coindexed access to an unlimited polymorphic object at" } + allocate(t :: a(3)[*]) IF (this_image() == num_images()) THEN SELECT TYPE (a) TYPE IS (t)