libcaf.h: Add caf_reference_type.

libgfortran/ChangeLog:

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

	* caf/libcaf.h: Add caf_reference_type.
	* caf/mpi.c: Adapted signature of caf_register().
	* caf/single.c (struct caf_single_token): Added to keep the pointer
	to the memory registered and array descriptor.
	(caf_internal_error): Added convenience interface.
	(_gfortran_caf_register): Adapted to work with caf_single_token and
	return memory in the array descriptor.
	(_gfortran_caf_deregister): Same.
	(assign_char1_from_char4): Fixed style.
	(convert_type): Fixed incorrect conversion.
	(_gfortran_caf_get): Adapted to work with caf_single_token.
	(_gfortran_caf_send): Same.
	(_gfortran_caf_sendget): Same.
	(copy_data): Added to stop repeating it in all _by_ref functions.
	(get_for_ref): Recursive getting of coarray data using a chain of
	references.
	(_gfortran_caf_get_by_ref): Driver for computing the memory needed for
	the get and checking properties of the operation.
	(send_by_ref): Same as get_for_ref but for sending data.
	(_gfortran_caf_send_by_ref): Same like caf_get_by_ref but for sending.
	(_gfortran_caf_sendget_by_ref): Uses get_by_ref and send_by_ref to
	implement sendget for reference chains.
	(_gfortran_caf_atomic_define): Adapted to work with caf_single_token.
	(_gfortran_caf_atomic_ref): Likewise.
	(_gfortran_caf_atomic_cas): Likewise.
	(_gfortran_caf_atomic_op): Likewise.
	(_gfortran_caf_event_post): Likewise.
	(_gfortran_caf_event_wait): Likewise.
	(_gfortran_caf_event_query): Likewise.
	(_gfortran_caf_lock): Likewise.
	(_gfortran_caf_unlock): Likewise.


gcc/testsuite/ChangeLog:

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

	* gfortran.dg/coarray/alloc_comp_4.f90: New test.
	* gfortran.dg/coarray_38.f90:
	* gfortran.dg/coarray_alloc_comp_1.f08: New test.
	* gfortran.dg/coarray_alloc_comp_2.f08: New test.
	* gfortran.dg/coarray_allocate_7.f08: New test.
	* gfortran.dg/coarray_allocate_8.f08: New test.
	* gfortran.dg/coarray_allocate_9.f08: New test.
	* gfortran.dg/coarray_lib_alloc_1.f90: Adapted scan-tree-dumps to expect
	new caf_register.
	* gfortran.dg/coarray_lib_alloc_2.f90: Same.
	* gfortran.dg/coarray_lib_alloc_3.f90: Same.
	* gfortran.dg/coarray_lib_comm_1.f90: Adapted scan-tree-dumps to expect
	get_by_refs.
	* gfortran.dg/coarray_lib_token_3.f90: Same as for coarray_lib_alloc2.
	* gfortran.dg/coarray_lock_7.f90: Same.
	* gfortran.dg/coarray_poly_5.f90: Same.
	* gfortran.dg/coarray_poly_6.f90: Same.
	* gfortran.dg/coarray_poly_7.f90: Same.
	* gfortran.dg/coarray_poly_8.f90: Same.
	* gfortran.dg/coindexed_1.f90: Changed errors expected.

gcc/fortran/ChangeLog:

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

	* expr.c (gfc_check_assign): Added flag to control whether datatype
	conversion is allowed.
	* gfortran.h: Added caf-token-tree to gfc_component.  Changed
	prototypes mostly to add whether datatype conversion is allowed.
	* gfortran.texi: Added documentation for the caf_reference_t and the
	caf_*_by_ref function.
	* primary.c (caf_variable_attr): Similar to gfc_variable_attr but
	focused on the needs of coarrays.
	(gfc_caf_attr): Same.
	* resolve.c (resolve_ordinary_assign): Set the conversion allowed
	flag when not in a coarray.
	* trans-array.c (gfc_array_init_size): Moved setting of array
	descriptor's datatype before the alloc, because caf_register needs it.
	(gfc_array_allocate): Changed notion of whether an array is a coarray.
	(gfc_array_deallocate): Same.
	(gfc_alloc_allocatable_for_assignment): Added setting of coarray's
	array descriptor datatype before the register.  And using deregister/
	register to mimmick a realloc for coarrays.
	* trans-decl.c (gfc_build_builtin_function_decls): Corrected signatures
	of old caf-functions and added signature definitions of the _by_ref
	ones.
	(generate_coarray_sym_init): Adapted to new caf_register signature.
	* trans-expr.c (gfc_conv_scalar_to_descriptor): Make sure a constant
	is translated to an lvalue expression before use in an array
	descriptor.
	(gfc_get_ultimate_alloc_ptr_comps_caf_token): New function.  Get the
	last allocatable component's coarray token.
	(gfc_get_tree_for_caf_expr): For top-level object get the coarray
	token and check for unsupported features.
	(gfc_get_caf_token_offset): Getting the offset might procude new
	statements, which now are stored in the pre and post of the current se.
	(gfc_caf_get_image_index): For this image return a call to
	caf_this_image.
	(expr_may_alias_variables): Check that the result is set for testing
	its properties.
	(alloc_scalar_allocatable_for_assignment): Added auto allocation of
	coarray components.
	(gfc_trans_assignment_1): Rewrite an assign to a coarray object to
	be a sendget.
	* trans-intrinsic.c (conv_caf_vector_subscript_elem): Corrected
	wrong comment.
	(compute_component_offset): Compute the correct offset a structure
	member.
	(conv_expr_ref_to_caf_ref): Convert to a chain of refs into
	caf_references.
	(gfc_conv_intrinsic_caf_get): Call caf_get_by_ref instead of caf_get.
	(conv_caf_send): Call caf_*_by_ref for coarrays that need
	reallocation.
	(gfc_conv_intrinsic_function): Adapted to new signuature of the caf
	drivers.
	(conv_intrinsic_atomic_op): Add pre and post statements correctly.
	(conv_intrinsic_atomic_ref): Same.
	(conv_intrinsic_atomic_cas): Same.
	(conv_intrinsic_event_query): Same.
	* trans-stmt.c (gfc_trans_lock_unlock): Same.
	(gfc_trans_event_post_wait): Same.
	(gfc_trans_allocate): Support allocation of allocatable coarrays.
	(gfc_trans_deallocate): And there deallocation.
	* trans-types.c (gfc_typenode_for_spec): Added flag to control whether
	a component is part of coarray.  When so, then add space to store a
	coarray token.
	(gfc_build_array_type): Same.
	(gfc_get_array_descriptor_base): Same.
	(gfc_get_array_type_bounds): Same.
	(gfc_sym_type): Same.
	(gfc_get_derived_type): Same.
	(gfc_get_caf_reference_type): Declare the caf_reference_type.
	* trans-types.h: Prototype changes only.
	* trans.c (gfc_allocate_using_lib): Use the updated caf_register
	signature.
	(gfc_allocate_allocatable): Same.
	(gfc_deallocate_with_status): Same.
	* trans.h: Defined the runtime types for caf_reference_t and the enums.

From-SVN: r240231

1 files changed, 104 insertions, 23 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 2699a76..bb33a23 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5083,19 +5083,19 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
   stride = gfc_index_one_node;
   offset = gfc_index_zero_node;
 
-  /* Set the dtype.  */
+  /* Set the dtype before the alloc, because registration of coarrays needs
+     it initialized.  */
   if (expr->ts.type == BT_CHARACTER && expr->ts.deferred
       && TREE_CODE (expr->ts.u.cl->backend_decl) == VAR_DECL)
     {
       type = gfc_typenode_for_spec (&expr->ts);
       tmp = gfc_conv_descriptor_dtype (descriptor);
-      gfc_add_modify (descriptor_block, tmp,
-		      gfc_get_dtype_rank_type (rank, type));
+      gfc_add_modify (pblock, tmp, gfc_get_dtype_rank_type (rank, type));
     }
   else
     {
       tmp = gfc_conv_descriptor_dtype (descriptor);
-      gfc_add_modify (descriptor_block, tmp, gfc_get_dtype (type));
+      gfc_add_modify (pblock, tmp, gfc_get_dtype (type));
     }
 
   or_expr = boolean_false_node;
@@ -5404,7 +5404,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   stmtblock_t elseblock;
   gfc_expr **lower;
   gfc_expr **upper;
-  gfc_ref *ref, *prev_ref = NULL;
+  gfc_ref *ref, *prev_ref = NULL, *coref;
+  gfc_se caf_se;
   bool allocatable, coarray, dimension, alloc_w_e3_arr_spec = false;
 
   ref = expr->ref;
@@ -5418,16 +5419,25 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   if (!prev_ref)
     {
       allocatable = expr->symtree->n.sym->attr.allocatable;
-      coarray = expr->symtree->n.sym->attr.codimension;
       dimension = expr->symtree->n.sym->attr.dimension;
     }
   else
     {
       allocatable = prev_ref->u.c.component->attr.allocatable;
-      coarray = prev_ref->u.c.component->attr.codimension;
       dimension = prev_ref->u.c.component->attr.dimension;
     }
 
+  /* For allocatable/pointer arrays in derived types, one of the refs has to be
+     a coarray.  In this case it does not matter whether we are on this_image
+     or not.  */
+  coarray = false;
+  for (coref = expr->ref; coref; coref = coref->next)
+    if (coref->type == REF_ARRAY && coref->u.ar.codimen > 0)
+      {
+	coarray = true;
+	break;
+      }
+
   if (!dimension)
     gcc_assert (coarray);
 
@@ -5482,6 +5492,9 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   overflow = integer_zero_node;
 
   gfc_init_block (&set_descriptor_block);
+  /* Take the corank only from the actual ref and not from the coref.  The
+     later will mislead the generation of the array dimensions for allocatable/
+     pointer components in derived types.  */
   size = gfc_array_init_size (se->expr, alloc_w_e3_arr_spec ? expr->rank
 							   : ref->u.ar.as->rank,
 			      coarray ? ref->u.ar.as->corank : 0,
@@ -5517,6 +5530,7 @@ 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.  */
@@ -5527,16 +5541,22 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   STRIP_NOPS (pointer);
 
   if (coarray && flag_coarray == GFC_FCOARRAY_LIB)
-    token = gfc_build_addr_expr (NULL_TREE,
-				 gfc_conv_descriptor_token (se->expr));
+    {
+      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_build_addr_expr (NULL_TREE, token);
+    }
 
   /* The allocatable variant takes the old pointer as first argument.  */
   if (allocatable)
     gfc_allocate_allocatable (&elseblock, pointer, size, token,
-			      status, errmsg, errlen, label_finish, expr);
+			      status, errmsg, errlen, label_finish, expr,
+			      coref != NULL ? coref->u.ar.as->corank : 0);
   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,
@@ -5592,7 +5612,7 @@ gfc_array_deallocate (tree descriptor, tree pstat, tree errmsg, tree errlen,
   tree var;
   tree tmp;
   stmtblock_t block;
-  bool coarray = gfc_is_coarray (expr);
+  bool coarray = gfc_caf_attr (expr).codimension;
 
   gfc_start_block (&block);
 
@@ -8659,6 +8679,10 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
   int n;
   int dim;
   gfc_array_spec * as;
+  bool coarray = (flag_coarray == GFC_FCOARRAY_LIB
+		  && gfc_caf_attr (expr1, true).codimension);
+  tree token;
+  gfc_se caf_se;
 
   /* x = f(...) with x allocatable.  In this case, expr1 is the rhs.
      Find the lhs expression in the loop chain and set expr1 and
@@ -8973,11 +8997,30 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
       gfc_add_modify (&fblock, tmp,
 		      gfc_get_dtype_rank_type (expr1->rank,type));
     }
+  else if (coarray && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
+    {
+      gfc_add_modify (&fblock, gfc_conv_descriptor_dtype (desc),
+		      gfc_get_dtype (TREE_TYPE (desc)));
+    }
 
   /* Realloc expression.  Note that the scalarizer uses desc.data
      in the array reference - (*desc.data)[<element>].  */
   gfc_init_block (&realloc_block);
+  gfc_init_se (&caf_se, NULL);
 
+  if (coarray)
+    {
+      token = gfc_get_ultimate_alloc_ptr_comps_caf_token (&caf_se, expr1);
+      if (token == NULL_TREE)
+	{
+	  tmp = gfc_get_tree_for_caf_expr (expr1);
+	  gfc_get_caf_token_offset (&caf_se, &token, NULL, tmp, NULL_TREE,
+				    expr1);
+	  token = gfc_build_addr_expr (NULL_TREE, token);
+	}
+
+      gfc_add_block_to_block (&realloc_block, &caf_se.pre);
+    }
   if ((expr1->ts.type == BT_DERIVED)
 	&& expr1->ts.u.derived->attr.alloc_comp)
     {
@@ -8986,12 +9029,32 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
       gfc_add_expr_to_block (&realloc_block, tmp);
     }
 
-  tmp = build_call_expr_loc (input_location,
-			     builtin_decl_explicit (BUILT_IN_REALLOC), 2,
-			     fold_convert (pvoid_type_node, array1),
-			     size2);
-  gfc_conv_descriptor_data_set (&realloc_block,
-				desc, tmp);
+  if (!coarray)
+    {
+      tmp = build_call_expr_loc (input_location,
+				 builtin_decl_explicit (BUILT_IN_REALLOC), 2,
+				 fold_convert (pvoid_type_node, array1),
+				 size2);
+      gfc_conv_descriptor_data_set (&realloc_block,
+				    desc, tmp);
+    }
+  else
+    {
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_caf_deregister,
+				 4, token, null_pointer_node,
+				 null_pointer_node, integer_zero_node);
+      gfc_add_expr_to_block (&realloc_block, tmp);
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_caf_register,
+				 7, size2,
+				 build_int_cst (integer_type_node,
+						GFC_CAF_COARRAY_ALLOC),
+				 token, gfc_build_addr_expr (NULL_TREE, desc),
+				 null_pointer_node, null_pointer_node,
+				 integer_zero_node);
+      gfc_add_expr_to_block (&realloc_block, tmp);
+    }
 
   if ((expr1->ts.type == BT_DERIVED)
 	&& expr1->ts.u.derived->attr.alloc_comp)
@@ -9001,6 +9064,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
       gfc_add_expr_to_block (&realloc_block, tmp);
     }
 
+  gfc_add_block_to_block (&realloc_block, &caf_se.post);
   realloc_expr = gfc_finish_block (&realloc_block);
 
   /* Only reallocate if sizes are different.  */
@@ -9011,16 +9075,33 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 
   /* Malloc expression.  */
   gfc_init_block (&alloc_block);
-  tmp = build_call_expr_loc (input_location,
-			     builtin_decl_explicit (BUILT_IN_MALLOC),
-			     1, size2);
-  gfc_conv_descriptor_data_set (&alloc_block,
-				desc, tmp);
+  if (!coarray)
+    {
+      tmp = build_call_expr_loc (input_location,
+				 builtin_decl_explicit (BUILT_IN_MALLOC),
+				 1, size2);
+      gfc_conv_descriptor_data_set (&alloc_block,
+				    desc, tmp);
+    }
+  else
+    {
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_caf_register,
+				 7, size2,
+				 build_int_cst (integer_type_node,
+						GFC_CAF_COARRAY_ALLOC),
+				 token, gfc_build_addr_expr (NULL_TREE, desc),
+				 null_pointer_node, null_pointer_node,
+				 integer_zero_node);
+      gfc_add_expr_to_block (&alloc_block, tmp);
+    }
+
 
   /* We already set the dtype in the case of deferred character
      length arrays.  */
   if (!(GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
-        && expr1->ts.type == BT_CHARACTER && expr1->ts.deferred))
+	&& ((expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
+	    || coarray)))
     {
       tmp = gfc_conv_descriptor_dtype (desc);
       gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc)));