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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 53fab3d8fc8388303679bbdc5f000684dcc1f7bc..ea28ae55f9387d79b6af40083add45adcf2b9047 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+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

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0b9776009400baa4cfc637f20b1816eb39dd2db3..50312fed3074f01a6ff5dd4bcdf84e5d96ed58d9 100644 (file)
--- 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 954f7b3afd405ed609798ff0b0eb9b36c5a1242b..a499c3273865481945b993d5cff64db0e6edfeb6 100644 (file)
--- 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 27a6bab7a0505dfb09f67f56a77d3abfda2bce4a..05122d90616134ed704d572a447830cd2562be6d 100644 (file)
--- 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 11fc7a8de85a61e519d7823c5fcff5bed873e134..9e8204174bc97c0dd3f99a70ff591e4b916b1c01 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.

diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_10.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_10.f08
new file mode 100644 (file)
index 0000000..30ee216
--- /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 b25f2f83d235f9836f97f7164c411e97b9cf150f..932442c4b3229438b6a40f7aa40f92705e33f958 100644 (file)
--- 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)