Add offset to allocatable shared coarrays.

This adds the calculation of the offset for allocatable coarrays,
which was missing before, and fixes the resulting fallout for
ALLOCATED.  Additionally, it prepares the way for STAT and ERRMSG
for ALLOCATE of coarrays, but that still needs changes to
gfc_trans_allocate.

gcc/fortran/ChangeLog:

	* trans-array.c (gfc_conv_array_ref): If se->address_only is set,
	throw away all the offset calculation.
	(gfc_allocate_shared_coarray): Add arguments stat, errmsg and
	errlen to call to allocate.  Calculate offset for allocatable
	coarrays.
	(gfc_array_allocate): Adjust call to gfc_allocate_shared_coarray.
	* trans-array.h (gfc_allocate_shared_coarray): Change prototype
	of cas_coarray_alloc.
	* trans-decl.c (gfc_build_builtin_function_decls): Adjust
	cas_coarray_alloc to changed prototypes.
	(gfc_trans_shared_coarray): Adjust call to gfc_allocate_shared_coarray.
	* trans-intrinsic.c (gfc_conv_allocated): Set address_only on se.
	* trans.h: Add flag address_only to gfc_se.

libgfortran/ChangeLog:

	* caf_shared/wrapper.c (cas_coarray_alloc): Add status, error and
	errmsg arguments and their checking.

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
+