libcaf.h: Add new action types for (de-)registration of allocatable components in derived...

libgfortran/ChangeLog:

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

	* caf/libcaf.h: Add new action types for (de-)registration of
	allocatable components in derived type coarrays.  Add _caf_is_present
	prototype.
	* caf/single.c (_gfortran_caf_register): Add support for registration
	only and allocation of already registered allocatable components in
	derived type coarrays.
	(_gfortran_caf_deregister): Add mode to deallocate but not deregister
	an allocatable component in a derived type coarray.
	(_gfortran_caf_is_present): New function.  Query whether an
	allocatable component in a derived type coarray on a remote image is
	allocated.


gcc/testsuite/ChangeLog:

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

	* gfortran.dg/coarray/alloc_comp_1.f90: Fix tree-dump scans to adhere
	to the changed interfaces.
	* gfortran.dg/coarray_alloc_comp_1.f08: Likewise.
	* gfortran.dg/coarray_allocate_7.f08: Likewise.
	* gfortran.dg/coarray_lib_alloc_1.f90: Likewise.
	* gfortran.dg/coarray_lib_alloc_2.f90: Likewise.
	* gfortran.dg/coarray_lib_alloc_3.f90: Likewise.
	* gfortran.dg/coarray_lib_comm_1.f90: Likewise.
	* gfortran.dg/coarray_lib_alloc_4.f90: New test.

gcc/fortran/ChangeLog:

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

	* check.c (gfc_check_allocated): By pass the caf_get call and check on
	the array.
	* gfortran.h: Add optional flag to gfc_caf_attr.
	* gfortran.texi: Document new enum values and _caf_is_present function.
	* primary.c (caf_variable_attr): Add optional flag to indicate that the
	expression is reffing a component.
	(gfc_caf_attr): Likewise.
	* trans-array.c (gfc_array_deallocate): Handle deallocation mode for
	coarray deregistration.
	(gfc_trans_dealloc_allocated): Likewise.
	(duplicate_allocatable): Use constants instead of
        creating custom constant tree node of zero or one.  Use gfc_add_modify
        convenience function.
	(duplicate_allocatable_coarray): This function is similar to
	duplicate_allocatable but tailored to handle coarrays.
	(caf_enabled): Check whether in-derived-type coarray processing is
	enabled.
	(caf_in_coarray): Check that in-derived-type coarray processing is
	enabled and currently in a derived-typed coarray.
	(gfc_caf_is_dealloc_only): Return true, when deallocate only is
	desired for components in derived typed coarrays.
	(structure_alloc_comps): A mode for handling coarrays, that is no
	longer encode in the purpose.  This makes the use cases of the
	routine more flexible without repeating.  Allocatable components in
	derived type coarrays are now registered only when nullifying an
	object and allocated before copying data into them.
	(gfc_nullify_alloc_comp): Use the caf_mode of structure_alloc_comps
	now.
	(gfc_deallocate_alloc_comp): Likewise.
	(gfc_deallocate_alloc_comp_no_caf): Likewise.
	(gfc_reassign_alloc_comp_caf): Likewise.
	(gfc_copy_alloc_comp): Likewise.
	(gfc_copy_only_alloc_comp): Likewise.
	(gfc_alloc_allocatable_for_assignment): Make use to the cheaper way of
	reallocating a coarray without deregistering and reregistering it.
	(gfc_trans_deferred_array): Initialize the coarray token correctly for
	deferred variables and tear them down on exit.
	* trans-array.h: Change some prototypes to add the coarray (de-)
	registration modes.  Add prototype for checking if deallocate only is
	selected for components in derived typed coarrays.
	* trans-decl.c (gfc_build_builtin_function_decls): Generate the
	declarations for the changed/new caf-lib routines.
	(gfc_trans_deferred_vars): Ensure deferred variables are (de-)
	registered correctly on procedure entry/exit.
	(generate_coarray_sym_init): Use constants.
	* trans-expr.c (gfc_conv_procedure_call): Propagate coarray allocation
	modes accordingly.
	(gfc_trans_alloc_subarray_assign): Likewise.
	(gfc_trans_subcomponent_assign): Likewise.
	(gfc_trans_structure_assign): Generate code to register the components
	of a derived type coarray prior to initialization.
	(gfc_conv_structure): Set flag that the structure is in a coarray.
	(gfc_trans_scalar_assign): Add flag to indicate being in a coarray and
	set the structure_alloc_comps modes correctly.
	(gfc_trans_assignment_1): Figure being in a coarray expression.
	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Adapt to new
	structure_alloc_comps interface.
	(conv_caf_send): Use the old API as long as possible.
	(trans_caf_is_present): Generate code to check whether an allocatable
	component in a derived typed coarray is allocated on a remote image.
	(caf_this_image_ref): Return true, when only reffing this image.
	(gfc_conv_allocated): Convert allocated queries on allocatable
	components to the library API.
	(conv_intrinsic_move_alloc): Adapt to new interface of
	structure_alloc_comps.
	* trans-openmp.c (gfc_walk_alloc_comps): Likewise.
	(gfc_omp_clause_assign_op): Likewise.
	(gfc_omp_clause_dtor): Likewise.
	* trans-stmt.c (gfc_trans_deallocate): Figure which mode to use when
	deallocating allocatable components in derived type coarras.
	* trans.c (gfc_allocate_using_lib): Renamed to
	gfc_allcate_using_caf_lib.
	(gfc_allocate_allocatable): Set the registration mode/type of caf-
	register calls adapting to all the possible allocatable objects.
	(gfc_deallocate_with_status): Add deregistration mode for allocatable
	components in derived type coarrays.
	(gfc_deallocate_scalar_with_status): Likewise.
	* trans.h (enum gfc_coarray_type): Renamed to gfc_coarray_regtype to
	avoid collision with gfc_coarray_deregtype.

From-SVN: r243021

1 files changed, 358 insertions, 90 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 1708f7c..803462a4 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5633,12 +5633,13 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 
 tree
 gfc_array_deallocate (tree descriptor, tree pstat, tree errmsg, tree errlen,
-		      tree label_finish, gfc_expr* expr)
+		      tree label_finish, gfc_expr* expr,
+		      int coarray_dealloc_mode)
 {
   tree var;
   tree tmp;
   stmtblock_t block;
-  bool coarray = gfc_caf_attr (expr).codimension;
+  bool coarray = coarray_dealloc_mode != GFC_CAF_COARRAY_NOCOARRAY;
 
   gfc_start_block (&block);
 
@@ -5648,7 +5649,8 @@ gfc_array_deallocate (tree descriptor, tree pstat, tree errmsg, tree errlen,
 
   /* Parameter is the address of the data component.  */
   tmp = gfc_deallocate_with_status (coarray ? descriptor : var, pstat, errmsg,
-				    errlen, label_finish, false, expr, coarray);
+				    errlen, label_finish, false, expr,
+				    coarray_dealloc_mode);
   gfc_add_expr_to_block (&block, tmp);
 
   /* Zero the data pointer; only for coarrays an error can occur and then
@@ -7782,11 +7784,13 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
 /* Generate code to deallocate an array, if it is allocated.  */
 
 tree
-gfc_trans_dealloc_allocated (tree descriptor, bool coarray, gfc_expr *expr)
+gfc_trans_dealloc_allocated (tree descriptor, gfc_expr *expr,
+			     int coarray_dealloc_mode)
 {
   tree tmp;
   tree var;
   stmtblock_t block;
+  bool coarray = coarray_dealloc_mode != GFC_CAF_COARRAY_NOCOARRAY;
 
   gfc_start_block (&block);
 
@@ -7797,8 +7801,8 @@ gfc_trans_dealloc_allocated (tree descriptor, bool coarray, gfc_expr *expr)
      Although it is ignored here, it's presence ensures that arrays that
      are already deallocated are ignored.  */
   tmp = gfc_deallocate_with_status (coarray ? descriptor : var, NULL_TREE,
-				    NULL_TREE, NULL_TREE, NULL_TREE, true,
-				    expr, coarray);
+				    NULL_TREE, NULL_TREE, NULL_TREE, true, expr,
+				    coarray_dealloc_mode);
   gfc_add_expr_to_block (&block, tmp);
 
   /* Zero the data pointer.  */
@@ -7855,9 +7859,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
 
   if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
     {
-      tmp = null_pointer_node;
-      tmp = fold_build2_loc (input_location, MODIFY_EXPR, type, dest, tmp);
-      gfc_add_expr_to_block (&block, tmp);
+      gfc_add_modify (&block, dest, fold_convert (type, null_pointer_node));
       null_data = gfc_finish_block (&block);
 
       gfc_init_block (&block);
@@ -7869,9 +7871,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
       if (!no_malloc)
 	{
 	  tmp = gfc_call_malloc (&block, type, size);
-	  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
-				 dest, fold_convert (type, tmp));
-	  gfc_add_expr_to_block (&block, tmp);
+	  gfc_add_modify (&block, dest, fold_convert (type, tmp));
 	}
 
       if (!no_memcpy)
@@ -7967,17 +7967,152 @@ gfc_duplicate_allocatable_nocopy (tree dest, tree src, tree type, int rank)
 }
 
 
+static tree
+duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src,
+			       tree type, int rank)
+{
+  tree tmp;
+  tree size;
+  tree nelems;
+  tree null_cond;
+  tree null_data;
+  stmtblock_t block, globalblock;
+
+  /* If the source is null, set the destination to null.  Then,
+     allocate memory to the destination.  */
+  gfc_init_block (&block);
+  gfc_init_block (&globalblock);
+
+  if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
+    {
+      gfc_se se;
+      symbol_attribute attr;
+      tree dummy_desc;
+
+      gfc_init_se (&se, NULL);
+      dummy_desc = gfc_conv_scalar_to_descriptor (&se, dest, attr);
+      gfc_add_block_to_block (&globalblock, &se.pre);
+      size = TYPE_SIZE_UNIT (TREE_TYPE (type));
+
+      gfc_add_modify (&block, dest, fold_convert (type, null_pointer_node));
+      gfc_allocate_using_caf_lib (&block, dummy_desc, size,
+				  gfc_build_addr_expr (NULL_TREE, dest_tok),
+				  NULL_TREE, NULL_TREE, NULL_TREE,
+				  GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY);
+      null_data = gfc_finish_block (&block);
+
+      gfc_init_block (&block);
+
+      gfc_allocate_using_caf_lib (&block, dummy_desc,
+				  fold_convert (size_type_node, size),
+				  gfc_build_addr_expr (NULL_TREE, dest_tok),
+				  NULL_TREE, NULL_TREE, NULL_TREE,
+				  GFC_CAF_COARRAY_ALLOC);
+
+      tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
+      tmp = build_call_expr_loc (input_location, tmp, 3, dest, src,
+				 fold_convert (size_type_node, size));
+      gfc_add_expr_to_block (&block, tmp);
+    }
+  else
+    {
+      /* Set the rank or unitialized memory access may be reported.  */
+      tmp = gfc_conv_descriptor_dtype (dest);
+      gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp), rank));
+
+      if (rank)
+	nelems = gfc_full_array_size (&block, src, rank);
+      else
+	nelems = integer_one_node;
+
+      tmp = fold_convert (size_type_node,
+			  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+      size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+			      fold_convert (size_type_node, nelems), tmp);
+
+      gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
+      gfc_allocate_using_caf_lib (&block, dest, fold_convert (size_type_node,
+							      size),
+				  gfc_build_addr_expr (NULL_TREE, dest_tok),
+				  NULL_TREE, NULL_TREE, NULL_TREE,
+				  GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY);
+      null_data = gfc_finish_block (&block);
+
+      gfc_init_block (&block);
+      gfc_allocate_using_caf_lib (&block, dest,
+				  fold_convert (size_type_node, size),
+				  gfc_build_addr_expr (NULL_TREE, dest_tok),
+				  NULL_TREE, NULL_TREE, NULL_TREE,
+				  GFC_CAF_COARRAY_ALLOC);
+
+      tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
+      tmp = build_call_expr_loc (input_location, tmp, 3,
+				 gfc_conv_descriptor_data_get (dest),
+				 gfc_conv_descriptor_data_get (src),
+				 fold_convert (size_type_node, size));
+      gfc_add_expr_to_block (&block, tmp);
+    }
+
+  tmp = gfc_finish_block (&block);
+
+  /* Null the destination if the source is null; otherwise do
+     the register and copy.  */
+  if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src)))
+    null_cond = src;
+  else
+    null_cond = gfc_conv_descriptor_data_get (src);
+
+  null_cond = convert (pvoid_type_node, null_cond);
+  null_cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			       null_cond, null_pointer_node);
+  gfc_add_expr_to_block (&globalblock, build3_v (COND_EXPR, null_cond, tmp,
+						 null_data));
+  return gfc_finish_block (&globalblock);
+}
+
+
+/* Helper function to abstract whether coarray processing is enabled.  */
+
+static bool
+caf_enabled (int caf_mode)
+{
+  return (caf_mode & GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY)
+      == GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY;
+}
+
+
+/* Helper function to abstract whether coarray processing is enabled
+   and we are in a derived type coarray.  */
+
+static bool
+caf_in_coarray (int caf_mode)
+{
+  static const int pat = GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY
+			 | GFC_STRUCTURE_CAF_MODE_IN_COARRAY;
+  return (caf_mode & pat) == pat;
+}
+
+
+/* Helper function to abstract whether coarray is to deallocate only.  */
+
+bool
+gfc_caf_is_dealloc_only (int caf_mode)
+{
+  return (caf_mode & GFC_STRUCTURE_CAF_MODE_DEALLOC_ONLY)
+      == GFC_STRUCTURE_CAF_MODE_DEALLOC_ONLY;
+}
+
+
 /* Recursively traverse an object of derived type, generating code to
    deallocate, nullify or copy allocatable components.  This is the work horse
    function for the functions named in this enum.  */
 
-enum {DEALLOCATE_ALLOC_COMP = 1, DEALLOCATE_ALLOC_COMP_NO_CAF,
-      NULLIFY_ALLOC_COMP, COPY_ALLOC_COMP, COPY_ONLY_ALLOC_COMP,
-      COPY_ALLOC_COMP_CAF};
+enum {DEALLOCATE_ALLOC_COMP = 1, NULLIFY_ALLOC_COMP,
+      COPY_ALLOC_COMP, COPY_ONLY_ALLOC_COMP, REASSIGN_CAF_COMP};
 
 static tree
 structure_alloc_comps (gfc_symbol * der_type, tree decl,
-		       tree dest, int rank, int purpose)
+		       tree dest, int rank, int purpose, int caf_mode)
 {
   gfc_component *c;
   gfc_loopinfo loop;
@@ -8011,10 +8146,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
       /* Deref dest in sync with decl, but only when it is not NULL.  */
       if (dest)
 	dest = build_fold_indirect_ref_loc (input_location, dest);
-    }
 
-  /* Just in case it gets dereferenced.  */
-  decl_type = TREE_TYPE (decl);
+      /* Update the decl_type because it got dereferenced.  */
+      decl_type = TREE_TYPE (decl);
+    }
 
   /* If this is an array of derived types with allocatable components
      build a loop and recursively call this function.  */
@@ -8056,16 +8191,18 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 
       vref = gfc_build_array_ref (var, index, NULL);
 
-      if (purpose == COPY_ALLOC_COMP || purpose == COPY_ONLY_ALLOC_COMP)
-        {
+      if ((purpose == COPY_ALLOC_COMP || purpose == COPY_ONLY_ALLOC_COMP)
+	  && !caf_enabled (caf_mode))
+	{
 	  tmp = build_fold_indirect_ref_loc (input_location,
 					 gfc_conv_array_data (dest));
 	  dref = gfc_build_array_ref (tmp, index, NULL);
 	  tmp = structure_alloc_comps (der_type, vref, dref, rank,
-				       COPY_ALLOC_COMP);
+				       COPY_ALLOC_COMP, 0);
 	}
       else
-        tmp = structure_alloc_comps (der_type, vref, NULL_TREE, rank, purpose);
+	tmp = structure_alloc_comps (der_type, vref, NULL_TREE, rank, purpose,
+				     caf_mode);
 
       gfc_add_expr_to_block (&loopbody, tmp);
 
@@ -8111,7 +8248,6 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
       switch (purpose)
 	{
 	case DEALLOCATE_ALLOC_COMP:
-	case DEALLOCATE_ALLOC_COMP_NO_CAF:
 
 	  /* gfc_deallocate_scalar_with_status calls gfc_deallocate_alloc_comp
 	     (i.e. this function) so generate all the calls and suppress the
@@ -8128,21 +8264,57 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	      /* The finalizer frees allocatable components.  */
 	      called_dealloc_with_status
 		= gfc_add_comp_finalizer_call (&tmpblock, comp, c,
-					       purpose == DEALLOCATE_ALLOC_COMP);
+					       purpose == DEALLOCATE_ALLOC_COMP
+					       && caf_enabled (caf_mode));
 	    }
 	  else
 	    comp = NULL_TREE;
 
-	  if (c->attr.allocatable && !c->attr.proc_pointer
+	  if (c->attr.allocatable && !c->attr.proc_pointer && !same_type
 	      && (c->attr.dimension
-		  || (c->attr.codimension
-		      && purpose != DEALLOCATE_ALLOC_COMP_NO_CAF))
-	      && !same_type)
+		  || (caf_enabled (caf_mode)
+		      && (caf_in_coarray (caf_mode) || c->attr.codimension))))
 	    {
+	      /* Allocatable arrays or coarray'ed components (scalar or
+		 array).  */
+	      int caf_dereg_mode
+		  = (caf_in_coarray (caf_mode) || c->attr.codimension)
+		  ? (gfc_caf_is_dealloc_only (caf_mode)
+		     ? GFC_CAF_COARRAY_DEALLOCATE_ONLY
+		     : GFC_CAF_COARRAY_DEREGISTER)
+		  : GFC_CAF_COARRAY_NOCOARRAY;
 	      if (comp == NULL_TREE)
 		comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
 					decl, cdecl, NULL_TREE);
-	      tmp = gfc_trans_dealloc_allocated (comp, c->attr.codimension, NULL);
+
+	      if (c->attr.dimension || c->attr.codimension)
+		/* Deallocate array.  */
+		tmp = gfc_trans_dealloc_allocated (comp, NULL, caf_dereg_mode);
+	      else
+		{
+		  /* Deallocate scalar.  */
+		  tree cond = fold_build2_loc (input_location, NE_EXPR,
+					       boolean_type_node, comp,
+					       build_int_cst (TREE_TYPE (comp),
+							      0));
+
+		  tmp = fold_build3_loc (input_location, COMPONENT_REF,
+					 pvoid_type_node, decl, c->caf_token,
+					 NULL_TREE);
+		  tmp = build_call_expr_loc (input_location,
+					     gfor_fndecl_caf_deregister, 5,
+					     gfc_build_addr_expr (NULL_TREE,
+								  tmp),
+					     build_int_cst (integer_type_node,
+							    caf_dereg_mode),
+					     null_pointer_node,
+					     null_pointer_node,
+					     integer_zero_node);
+		  tmp = fold_build3_loc (input_location, COND_EXPR,
+					 void_type_node, cond, tmp,
+					 build_empty_stmt (input_location));
+		}
+
 	      gfc_add_expr_to_block (&tmpblock, tmp);
 	    }
 	  else if (c->attr.allocatable && !c->attr.codimension && !same_type)
@@ -8152,7 +8324,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 		comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
 					decl, cdecl, NULL_TREE);
 
-	      tmp = gfc_deallocate_scalar_with_status (comp, NULL, true, NULL,
+	      tmp = gfc_deallocate_scalar_with_status (comp, NULL_TREE,
+						       NULL_TREE, true, NULL,
 						       c->ts);
 	      gfc_add_expr_to_block (&tmpblock, tmp);
 	      called_dealloc_with_status = true;
@@ -8168,8 +8341,6 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	      tree is_allocated;
 	      tree ubound;
 	      tree cdesc;
-	      tree zero = build_int_cst (gfc_array_index_type, 0);
-	      tree unity = build_int_cst (gfc_array_index_type, 1);
 	      tree data;
 	      stmtblock_t dealloc_block;
 
@@ -8191,8 +8362,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 		  ubound = build_int_cst (gfc_array_index_type, 1);
 		}
 
-	      cdesc = gfc_get_array_type_bounds (tmp, 1, 0,
-						 &unity, &ubound, 1,
+	      cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
+						 &ubound, 1,
 						 GFC_ARRAY_ALLOCATABLE, false);
 
 	      cdesc = gfc_create_var (cdesc, "cdesc");
@@ -8201,11 +8372,13 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	      gfc_add_modify (&dealloc_block, gfc_conv_descriptor_dtype (cdesc),
 			      gfc_get_dtype_rank_type (1, tmp));
 	      gfc_conv_descriptor_lbound_set (&dealloc_block, cdesc,
-					      zero, unity);
+					      gfc_index_zero_node,
+					      gfc_index_one_node);
 	      gfc_conv_descriptor_stride_set (&dealloc_block, cdesc,
-					      zero, unity);
+					      gfc_index_zero_node,
+					      gfc_index_one_node);
 	      gfc_conv_descriptor_ubound_set (&dealloc_block, cdesc,
-					      zero, ubound);
+					      gfc_index_zero_node, ubound);
 
 	      if (c->attr.dimension)
 		data = gfc_conv_descriptor_data_get (comp);
@@ -8247,7 +8420,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 
 	  else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable
 		   && (!CLASS_DATA (c)->attr.codimension
-		       || purpose != DEALLOCATE_ALLOC_COMP_NO_CAF))
+		    || !caf_enabled (caf_mode)))
 	    {
 	      /* Allocatable CLASS components.  */
 
@@ -8257,11 +8430,15 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 				      TREE_TYPE (tmp), comp, tmp, NULL_TREE);
 
 	      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
-	        tmp = gfc_trans_dealloc_allocated (comp,
-					CLASS_DATA (c)->attr.codimension, NULL);
+		tmp = gfc_trans_dealloc_allocated (comp, NULL,
+						CLASS_DATA (c)->attr.codimension
+						? GFC_CAF_COARRAY_DEREGISTER
+						: GFC_CAF_COARRAY_NOCOARRAY);
 	      else
 		{
-		  tmp = gfc_deallocate_scalar_with_status (comp, NULL_TREE, true, NULL,
+		  tmp = gfc_deallocate_scalar_with_status (comp, NULL_TREE,
+							   NULL_TREE, true,
+							   NULL,
 							   CLASS_DATA (c)->ts);
 		  gfc_add_expr_to_block (&tmpblock, tmp);
 		  called_dealloc_with_status = true;
@@ -8317,7 +8494,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 				      decl, cdecl, NULL_TREE);
 	      rank = c->as ? c->as->rank : 0;
 	      tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE,
-					   rank, purpose);
+					   rank, purpose, caf_mode);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 
@@ -8326,14 +8503,20 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	  break;
 
 	case NULLIFY_ALLOC_COMP:
-	  if (c->attr.pointer || c->attr.proc_pointer)
+	  if (c->attr.pointer || c->attr.proc_pointer
+	      || !(c->attr.allocatable || (c->ts.type == BT_CLASS
+					   && CLASS_DATA (c)->attr.allocatable)
+		   || cmp_has_alloc_comps))
 	    continue;
-	  else if (c->attr.allocatable
-		   && (c->attr.dimension|| c->attr.codimension))
+
+	  /* Coarrays need the component to be initialized before the api-call
+	     is made.  */
+	  if (c->attr.allocatable && (c->attr.dimension || c->attr.codimension))
 	    {
 	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
 				      decl, cdecl, NULL_TREE);
 	      gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node);
+	      cmp_has_alloc_comps = false;
 	    }
 	  else if (c->attr.allocatable)
 	    {
@@ -8354,6 +8537,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 					 build_int_cst (TREE_TYPE (comp), 0));
 		  gfc_add_expr_to_block (&fnblock, tmp);
 		}
+	      cmp_has_alloc_comps = false;
 	    }
 	  else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
 	    {
@@ -8371,46 +8555,92 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 					 build_int_cst (TREE_TYPE (comp), 0));
 		  gfc_add_expr_to_block (&fnblock, tmp);
 		}
+	      cmp_has_alloc_comps = false;
+	    }
+
+	  if (flag_coarray == GFC_FCOARRAY_LIB
+	      && (caf_in_coarray (caf_mode) || c->attr.codimension))
+	    {
+	      /* Register the component with the coarray library.  */
+	      tree token;
+
+	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      decl, cdecl, NULL_TREE);
+	      if (c->attr.dimension || c->attr.codimension)
+		{
+		  tmp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+					 decl, cdecl, NULL_TREE);
+		  token = gfc_conv_descriptor_token (tmp);
+		}
+	      else
+		{
+		  gfc_se se;
+		  symbol_attribute attr;
+
+		  gfc_init_se (&se, NULL);
+		  gfc_clear_attr (&attr);
+		  token = fold_build3_loc (input_location, COMPONENT_REF,
+					   pvoid_type_node, decl, c->caf_token,
+					   NULL_TREE);
+		  comp = gfc_conv_scalar_to_descriptor (&se, comp, attr);
+		  gfc_add_block_to_block (&fnblock, &se.pre);
+		}
+
+	      /* NULL the member-token before registering it or uninitialized
+		 memory accesses may occur.  */
+	      gfc_add_modify (&fnblock, token, fold_convert (TREE_TYPE (token),
+							    null_pointer_node));
+	      gfc_allocate_using_caf_lib (&fnblock, comp, size_zero_node,
+					  gfc_build_addr_expr (NULL_TREE,
+							       token),
+					  NULL_TREE, NULL_TREE, NULL_TREE,
+					  GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY);
 	    }
-          else if (cmp_has_alloc_comps)
+
+	  if (cmp_has_alloc_comps)
 	    {
 	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
 				      decl, cdecl, NULL_TREE);
 	      rank = c->as ? c->as->rank : 0;
 	      tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE,
-					   rank, purpose);
+					   rank, purpose, caf_mode);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 	  break;
 
-	case COPY_ALLOC_COMP_CAF:
-	  if (!c->attr.codimension
-	      && (c->ts.type != BT_CLASS || CLASS_DATA (c)->attr.coarray_comp)
-	      && (c->ts.type != BT_DERIVED
-		  || !c->ts.u.derived->attr.coarray_comp))
-	    continue;
-
-	  comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl,
-				  cdecl, NULL_TREE);
-	  dcmp = fold_build3_loc (input_location, COMPONENT_REF, ctype, dest,
-				  cdecl, NULL_TREE);
-
-	  if (c->attr.codimension)
+	case REASSIGN_CAF_COMP:
+	  if (caf_enabled (caf_mode)
+	      && (c->attr.codimension
+		  || (c->ts.type == BT_CLASS
+		      && (CLASS_DATA (c)->attr.coarray_comp
+			  || caf_in_coarray (caf_mode)))
+		  || (c->ts.type == BT_DERIVED
+		      && (c->ts.u.derived->attr.coarray_comp
+			  || caf_in_coarray (caf_mode))))
+	      && !same_type)
 	    {
-	      if (c->ts.type == BT_CLASS)
+	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      decl, cdecl, NULL_TREE);
+	      dcmp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      dest, cdecl, NULL_TREE);
+
+	      if (c->attr.codimension)
 		{
-		  comp = gfc_class_data_get (comp);
-		  dcmp = gfc_class_data_get (dcmp);
-		}
-	      gfc_conv_descriptor_data_set (&fnblock, dcmp,
+		  if (c->ts.type == BT_CLASS)
+		    {
+		      comp = gfc_class_data_get (comp);
+		      dcmp = gfc_class_data_get (dcmp);
+		    }
+		  gfc_conv_descriptor_data_set (&fnblock, dcmp,
 					   gfc_conv_descriptor_data_get (comp));
-	    }
-	  else
-	    {
-	      tmp = structure_alloc_comps (c->ts.u.derived, comp, dcmp,
-					   rank, purpose);
-	      gfc_add_expr_to_block (&fnblock, tmp);
-
+		}
+	      else
+		{
+		  tmp = structure_alloc_comps (c->ts.u.derived, comp, dcmp,
+					       rank, purpose, caf_mode
+					   | GFC_STRUCTURE_CAF_MODE_IN_COARRAY);
+		  gfc_add_expr_to_block (&fnblock, tmp);
+		}
 	    }
 	  break;
 
@@ -8503,7 +8733,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	      gfc_add_modify (&fnblock, dcmp, tmp);
 	      add_when_allocated = structure_alloc_comps (c->ts.u.derived,
 							  comp, dcmp,
-							  rank, purpose);
+							  rank, purpose,
+							  caf_mode);
 	    }
 	  else
 	    add_when_allocated = NULL_TREE;
@@ -8530,11 +8761,24 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 	  else if (c->attr.allocatable && !c->attr.proc_pointer && !same_type
-		   && (!(cmp_has_alloc_comps && c->as) || c->attr.codimension))
+		   && (!(cmp_has_alloc_comps && c->as) || c->attr.codimension
+		       || caf_in_coarray (caf_mode)))
 	    {
 	      rank = c->as ? c->as->rank : 0;
 	      if (c->attr.codimension)
 		tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank);
+	      else if (flag_coarray == GFC_FCOARRAY_LIB
+		       && caf_in_coarray (caf_mode))
+		{
+		  tree dst_tok = c->as ? gfc_conv_descriptor_token (dcmp)
+				       : fold_build3_loc (input_location,
+							  COMPONENT_REF,
+							  pvoid_type_node, dest,
+							  c->caf_token,
+							  NULL_TREE);
+		  tmp = duplicate_allocatable_coarray (dcmp, dst_tok, comp,
+						       ctype, rank);
+		}
 	      else
 		tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank,
 						 add_when_allocated);
@@ -8562,7 +8806,8 @@ tree
 gfc_nullify_alloc_comp (gfc_symbol * der_type, tree decl, int rank)
 {
   return structure_alloc_comps (der_type, decl, NULL_TREE, rank,
-				NULLIFY_ALLOC_COMP);
+				NULLIFY_ALLOC_COMP,
+				GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY);
 }
 
 
@@ -8570,10 +8815,12 @@ gfc_nullify_alloc_comp (gfc_symbol * der_type, tree decl, int rank)
    deallocate allocatable components.  */
 
 tree
-gfc_deallocate_alloc_comp (gfc_symbol * der_type, tree decl, int rank)
+gfc_deallocate_alloc_comp (gfc_symbol * der_type, tree decl, int rank,
+			   int caf_mode)
 {
   return structure_alloc_comps (der_type, decl, NULL_TREE, rank,
-				DEALLOCATE_ALLOC_COMP);
+				DEALLOCATE_ALLOC_COMP,
+			      GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY | caf_mode);
 }
 
 
@@ -8586,14 +8833,15 @@ tree
 gfc_deallocate_alloc_comp_no_caf (gfc_symbol * der_type, tree decl, int rank)
 {
   return structure_alloc_comps (der_type, decl, NULL_TREE, rank,
-				DEALLOCATE_ALLOC_COMP_NO_CAF);
+				DEALLOCATE_ALLOC_COMP, 0);
 }
 
 
 tree
 gfc_reassign_alloc_comp_caf (gfc_symbol *der_type, tree decl, tree dest)
 {
-  return structure_alloc_comps (der_type, decl, dest, 0, COPY_ALLOC_COMP_CAF);
+  return structure_alloc_comps (der_type, decl, dest, 0, REASSIGN_CAF_COMP,
+				GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY);
 }
 
 
@@ -8601,9 +8849,11 @@ gfc_reassign_alloc_comp_caf (gfc_symbol *der_type, tree decl, tree dest)
    copy it and its allocatable components.  */
 
 tree
-gfc_copy_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank)
+gfc_copy_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank,
+		     int caf_mode)
 {
-  return structure_alloc_comps (der_type, decl, dest, rank, COPY_ALLOC_COMP);
+  return structure_alloc_comps (der_type, decl, dest, rank, COPY_ALLOC_COMP,
+				caf_mode);
 }
 
 
@@ -8613,7 +8863,8 @@ gfc_copy_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank)
 tree
 gfc_copy_only_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank)
 {
-  return structure_alloc_comps (der_type, decl, dest, rank, COPY_ONLY_ALLOC_COMP);
+  return structure_alloc_comps (der_type, decl, dest, rank,
+				COPY_ONLY_ALLOC_COMP, 0);
 }
 
 
@@ -9205,15 +9456,17 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
   else
     {
       tmp = build_call_expr_loc (input_location,
-				 gfor_fndecl_caf_deregister,
-				 4, token, null_pointer_node,
-				 null_pointer_node, integer_zero_node);
+				 gfor_fndecl_caf_deregister, 5, token,
+				 build_int_cst (integer_type_node,
+					       GFC_CAF_COARRAY_DEALLOCATE_ONLY),
+				 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),
+					   GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY),
 				 token, gfc_build_addr_expr (NULL_TREE, desc),
 				 null_pointer_node, null_pointer_node,
 				 integer_zero_node);
@@ -9398,7 +9651,20 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
 
   /* NULLIFY the data pointer, for non-saved allocatables.  */
   if (GFC_DESCRIPTOR_TYPE_P (type) && !sym->attr.save && sym->attr.allocatable)
-    gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node);
+    {
+      gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node);
+      if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+	{
+	  /* Declare the variable static so its array descriptor stays present
+	     after leaving the scope.  It may still be accessed through another
+	     image.  This may happen, for example, with the caf_mpi
+	     implementation.  */
+	  TREE_STATIC (descriptor) = 1;
+	  tmp = gfc_conv_descriptor_token (descriptor);
+	  gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp),
+						    null_pointer_node));
+	}
+    }
 
   gfc_restore_backend_locus (&loc);
   gfc_init_block (&cleanup);
@@ -9432,8 +9698,10 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
     {
       gfc_expr *e;
       e = has_finalizer ? gfc_lval_expr_from_sym (sym) : NULL;
-      tmp = gfc_trans_dealloc_allocated (sym->backend_decl,
-					 sym->attr.codimension, e);
+      tmp = gfc_trans_dealloc_allocated (sym->backend_decl, e,
+					 sym->attr.codimension
+					 ? GFC_CAF_COARRAY_DEREGISTER
+					 : GFC_CAF_COARRAY_NOCOARRAY);
       if (e)
 	gfc_free_expr (e);
       gfc_add_expr_to_block (&cleanup, tmp);