aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/trans-array.c54
-rw-r--r--gcc/fortran/trans-array.h3
-rw-r--r--gcc/fortran/trans-decl.c21
-rw-r--r--gcc/fortran/trans-intrinsic.c2
-rw-r--r--gcc/fortran/trans.h7
-rw-r--r--gcc/testsuite/gfortran.dg/caf-shared/coarray_allocate_3.f0827
6 files changed, 93 insertions, 21 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 39e6b6d..35afff5 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3865,8 +3865,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
add_to_offset (&cst_offset, &offset, tmp);
}
- if (flag_coarray == GFC_FCOARRAY_SHARED && need_impl_this_image
- && !se->no_impl_this_image)
+ if (flag_coarray == GFC_FCOARRAY_SHARED && need_impl_this_image)
{
tree off;
tree co_stride = gfc_conv_array_stride (decl, eff_dimen + 1);
@@ -3934,6 +3933,15 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
decl = NULL_TREE;
}
+ /* Early return - only taken for ALLOCATED for shared coarrays.
+ FIXME - this could probably be done more elegantly. */
+ if (se->address_only)
+ {
+ se->expr = build_array_ref (se->expr, build_int_cst (TREE_TYPE (offset), 0),
+ decl, se->class_vptr);
+ return;
+ }
+
se->expr = build_array_ref (se->expr, offset, decl, se->class_vptr);
}
@@ -5975,15 +5983,41 @@ gfc_cas_get_allocation_type (gfc_symbol * sym)
}
void
-gfc_allocate_shared_coarray (stmtblock_t *b, tree decl, tree size, int corank,
- int alloc_type)
+gfc_allocate_shared_coarray (stmtblock_t *b, tree decl, tree size, int rank,
+ int corank, int alloc_type, tree status,
+ tree errmsg, tree errlen, bool calc_offset)
{
+ tree st, err, elen;
+
+ if (status == NULL_TREE)
+ st = null_pointer_node;
+ else
+ st = gfc_build_addr_expr (NULL, status);
+
+ err = errmsg == NULL_TREE ? null_pointer_node : errmsg;
+ elen = errlen == NULL_TREE ? build_int_cst (gfc_charlen_type_node, 0) : errlen;
gfc_add_expr_to_block (b,
build_call_expr_loc (input_location, gfor_fndecl_cas_coarray_allocate,
- 4, gfc_build_addr_expr (pvoid_type_node, decl),
- size, build_int_cst (integer_type_node, corank),
- build_int_cst (integer_type_node, alloc_type)));
-
+ 7, gfc_build_addr_expr (pvoid_type_node, decl),
+ size, build_int_cst (integer_type_node, corank),
+ build_int_cst (integer_type_node, alloc_type),
+ st, err, elen));
+ if (calc_offset)
+ {
+ int i;
+ tree offset, stride, lbound, mult;
+ offset = build_int_cst (gfc_array_index_type, 0);
+ for (i = 0; i < rank + corank; i++)
+ {
+ stride = gfc_conv_array_stride (decl, i);
+ lbound = gfc_conv_array_lbound (decl, i);
+ mult = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, stride, lbound);
+ offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, offset, mult);
+ }
+ gfc_conv_descriptor_offset_set (b, decl, offset);
+ }
}
/* Initializes the descriptor and generates a call to _gfor_allocate. Does
@@ -6193,7 +6227,9 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
int alloc_type
= gfc_cas_get_allocation_type (expr->symtree->n.sym);
gfc_allocate_shared_coarray (&elseblock, se->expr, elem_size,
- ref->u.ar.as->corank, alloc_type);
+ ref->u.ar.as->rank, ref->u.ar.as->corank,
+ alloc_type, status, errmsg, errlen,
+ true);
}
/* The allocatable variant takes the old pointer as first argument. */
else if (allocatable)
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 66f59bb..2168e9d 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -31,7 +31,8 @@ enum gfc_coarray_allocation_type {
int gfc_cas_get_allocation_type (gfc_symbol *);
-void gfc_allocate_shared_coarray (stmtblock_t *, tree, tree, int, int);
+void gfc_allocate_shared_coarray (stmtblock_t *, tree, tree, int, int, int,
+ tree, tree, tree, bool);
/* Allow the bounds of a loop to be set from a callee's array spec. */
void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 91a5dca..f3526db 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4118,9 +4118,15 @@ gfc_build_builtin_function_decls (void)
get_identifier (PREFIX("cas_master")), ". r ", integer_type_node, 1,
build_pointer_type (build_function_type_list (void_type_node, NULL_TREE)));
gfor_fndecl_cas_coarray_allocate = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("cas_coarray_alloc")), ". . R R R ", integer_type_node, 4,
- pvoid_type_node, integer_type_node, integer_type_node, integer_type_node,
- NULL_TREE);
+ get_identifier (PREFIX("cas_coarray_alloc")), ". . R R R W W . ", integer_type_node, 7,
+ pvoid_type_node, /* desc. */
+ size_type_node, /* elem_size. */
+ integer_type_node, /* corank. */
+ integer_type_node, /* alloc_type. */
+ pvoid_type_node, /* stat. */
+ pvoid_type_node, /* errmsg. */
+ gfc_charlen_type_node, /* errmsg_len. */
+ NULL_TREE);
gfor_fndecl_cas_coarray_free = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("cas_coarray_free")), ". . R ", integer_type_node, 2,
pvoid_type_node, /* Pointer to the descriptor to be deallocated. */
@@ -4689,10 +4695,13 @@ gfc_trans_shared_coarray (stmtblock_t * init, stmtblock_t *cleanup, gfc_symbol *
init, &overflow,
NULL_TREE, &nelems, NULL,
NULL_TREE, true, NULL, &element_size);
- gfc_conv_descriptor_offset_set (init, decl, offset);
elem_size = size_in_bytes (gfc_get_element_type (TREE_TYPE(decl)));
- gfc_allocate_shared_coarray (init, decl, elem_size, sym->as->corank,
- alloc_type);
+ gfc_allocate_shared_coarray (init, decl, elem_size, sym->as->rank,
+ sym->as->corank, alloc_type, null_pointer_node,
+ null_pointer_node,
+ build_int_cst (gfc_charlen_type_node, 0),
+ false);
+ gfc_conv_descriptor_offset_set (init, decl, offset);
}
if (cleanup)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index e93cd3a..912c9b0 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -8832,7 +8832,7 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
{
/* Allocatable scalar. */
arg1se.want_pointer = 1;
- arg1se.no_impl_this_image = 1;
+ arg1se.address_only = 1;
gfc_conv_expr (&arg1se, arg1->expr);
tmp = arg1se.expr;
}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index f3cf33b..d3340b3 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -98,10 +98,9 @@ typedef struct gfc_se
arrays in gfc_conv_expr_descriptor. */
unsigned use_offset:1;
- /* For shared coarrays, do not add the offset for the implied
- this_image(). */
-
- unsigned no_impl_this_image:1;
+ /* Set if an array reference should be converted to an address of
+ its data pointer only. */
+ unsigned address_only:1;
unsigned want_coarray:1;
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/coarray_allocate_3.f08 b/gcc/testsuite/gfortran.dg/caf-shared/coarray_allocate_3.f08
new file mode 100644
index 0000000..bb9b5f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/coarray_allocate_3.f08
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+! Contributed by Ian Harvey <ian_harvey@bigpond.com>
+! Extended by Andre Vehreschild <vehre@gcc.gnu.org>
+! to test that coarray references in allocate work now
+! PR fortran/67451
+
+ program main
+ implicit none
+ type foo
+ integer :: bar = 99
+ end type
+ class(foo), dimension(:), allocatable :: foobar[:]
+ class(foo), dimension(:), allocatable :: some_local_object
+ allocate(foobar(10)[*])
+
+ allocate(some_local_object, source=foobar)
+
+ if (.not. allocated(foobar)) STOP 1
+ if (lbound(foobar, 1) /= 1 .OR. ubound(foobar, 1) /= 10) STOP 2
+ if (.not. allocated(some_local_object)) STOP 3
+ if (any(some_local_object(:)%bar /= [99, 99, 99, 99, 99, 99, 99, 99, 99, 99])) STOP 4
+
+ deallocate(some_local_object)
+ deallocate(foobar)
+ end program
+
generated by cgit v1.1 at 2025-05-30 11:31:23 +0000