diff mbox

[accaf,Fortran,v1] Generate caf-reference chains only from the first coarray reference on, and more.

Message ID 20160929140335.49237ec4@vepi2
State New
Headers show

Commit Message

Andre Vehreschild Sept. 29, 2016, 12:03 p.m. UTC
Hi all,

attached patch fixes an addressing issue for coarrays *in* derived types.
Before the patch the caf runtime reference chain was generated from the start
of the symbol to the last reference *and* the reference chain upto the coarray
in the derived type was used to call the caf_*_by_ref () functions. The patch
fixes this by skipping the generation of unnecessary caf runtime references. 

The second part fixes finding the token for coarrayed arrays. The new semantic
is, that each allocatable array has the coarray token in its .token member,
which the allocate_array now makes use of.

Bootstrapped and regtested ok on x86_64-linux/F23. Ok for trunk?

Regards,
	Andre

Comments

Paul Richard Thomas Sept. 30, 2016, 9:16 a.m. UTC | #1
Dear Andre,

Looks good to me - OK for trunk.

Thanks

Paul

On 29 September 2016 at 14:03, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi all,
>
> attached patch fixes an addressing issue for coarrays *in* derived types.
> Before the patch the caf runtime reference chain was generated from the start
> of the symbol to the last reference *and* the reference chain upto the coarray
> in the derived type was used to call the caf_*_by_ref () functions. The patch
> fixes this by skipping the generation of unnecessary caf runtime references.
>
> The second part fixes finding the token for coarrayed arrays. The new semantic
> is, that each allocatable array has the coarray token in its .token member,
> which the allocate_array now makes use of.
>
> Bootstrapped and regtested ok on x86_64-linux/F23. Ok for trunk?
>
> Regards,
>         Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
diff mbox

Patch

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0b97760..50312fe 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 954f7b3..a499c32 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 27a6bab..05122d9 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/gfortran.dg/coarray_allocate_10.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_10.f08
new file mode 100644
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 b25f2f8..932442c 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)