trans-array.c (gfc_array_allocate): Use the token from coarray's .token member.

gcc/fortran/ChangeLog:

2016-09-30  Andre Vehreschild  <vehre@gcc.gnu.org>

	* 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  <vehre@gcc.gnu.org>

	* gfortran.dg/coarray_allocate_10.f08: New test.
	* gfortran.dg/coindexed_1.f90: Above fixes allow execution.

From-SVN: r240650

gcc/fortran/ChangeLog

+2016-09-30  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	* 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  <james.greenhalgh@arm.com>
 
 	* options.c (gfc_post_options): Remove special case for

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,

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

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)
         {

gcc/testsuite/ChangeLog

+2016-09-30  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	* gfortran.dg/coarray_allocate_10.f08: New test.
+	* gfortran.dg/coindexed_1.f90: Above fixes allow execution.
+
 2016-09-30  Kyrylo Tkachov  <kyrylo.tkachov@arm.com>
 
 	* gcc.target/aarch64/ifcvt_avoid_const_materialization_1.c: New test.

gcc/testsuite/gfortran.dg/coarray_allocate_10.f08

+! { 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

gcc/testsuite/gfortran.dg/coindexed_1.f90

-! { 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)