Early patch. Not yet working. Correctly avoids the reallocation and the
wrong freeing. However, one still needs to keep "lhs.comp.data", which
is currently overridden by "lhs = rhs"; on would need to do afterwards a
lhs.alloc_comp.data = tmp.alloc_comp.data" to restore the value.


Test case:

type t
  integer, allocatable :: A[:]
end type t

  type(t) :: x, y
  x = y
end


Dump (except):

      x.a.data = 0B;
      y.a.data = 0B;
      {
        struct t D.1751;

        D.1751 = x;
        x = y; /* OK but overrides x.a.data.  */
               /* MISSING: x.a.data = D.1751.a.data.  */

        if ((void *) y.a.data != 0B)
          __builtin_memcpy ((integer(kind=4) * restrict) x.a.data,
                            (integer(kind=4) * restrict) y.a.data, 4);
        else
          x.a.data = 0B;
      }


diff -it a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 6dc1e17..c770b8d 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6365,7 +6365,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
 	&& expr->expr_type != EXPR_VARIABLE)
     {
       tmp = build_fold_indirect_ref_loc (input_location, se->expr);
-      tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
+      tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank,
+				       true);
 
       /* The components shall be deallocated before their containing entity.  */
       gfc_prepend_expr_to_block (&se->post, tmp);
@@ -6569,7 +6570,8 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
      allocate memory to the destination.  */
   gfc_init_block (&block);
 
-  if (rank == 0)
+  /* Scalars except for those with codimension.  */
+  if (rank == 0 && !GFC_DESCRIPTOR_TYPE_P (type))
     {
       tmp = null_pointer_node;
       tmp = fold_build2_loc (input_location, MODIFY_EXPR, type, dest, tmp);
@@ -6596,7 +6598,11 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
       null_data = gfc_finish_block (&block);
 
       gfc_init_block (&block);
-      nelems = get_full_array_size (&block, src, rank);
+      if (rank == 0)
+	nelems = gfc_index_one_node;
+      else
+	nelems = get_full_array_size (&block, src, rank);
+
       tmp = fold_convert (gfc_array_index_type,
 			  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
       size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
@@ -6621,7 +6627,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
 
   /* Null the destination if the source is null; otherwise do
      the allocate and copy.  */
-  if (rank == 0)
+  if (rank == 0 && !GFC_DESCRIPTOR_TYPE_P (type))
     null_cond = src;
   else
     null_cond = gfc_conv_descriptor_data_get (src);
@@ -6655,12 +6661,14 @@ gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank)
    deallocate, nullify or copy allocatable components.  This is the work horse
    function for the functions named in this enum.  */
 
-enum {DEALLOCATE_ALLOC_COMP = 1, NULLIFY_ALLOC_COMP, COPY_ALLOC_COMP,
-      COPY_ONLY_ALLOC_COMP};
+enum alloc_comp_enum {
+  DEALLOCATE_ALLOC_COMP = 1, DEALLOCATE_ALLOC_COMP_NO_CAF,
+  NULLIFY_ALLOC_COMP, COPY_ALLOC_COMP, COPY_ONLY_ALLOC_COMP
+};
 
 static tree
 structure_alloc_comps (gfc_symbol * der_type, tree decl,
-		       tree dest, int rank, int purpose)
+		       tree dest, int rank, enum alloc_comp_enum purpose)
 {
   gfc_component *c;
   gfc_loopinfo loop;
@@ -6787,6 +6795,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
       switch (purpose)
 	{
 	case DEALLOCATE_ALLOC_COMP:
+	case DEALLOCATE_ALLOC_COMP_NO_CAF:
+	  if (c->attr.codimension && purpose == DEALLOCATE_ALLOC_COMP_NO_CAF)
+	    break;
+
 	  if (cmp_has_alloc_comps && !c->attr.pointer)
 	    {
 	      /* Do not deallocate the components of ultimate pointer
@@ -6903,7 +6915,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	  if (c->attr.allocatable && !cmp_has_alloc_comps)
 	    {
 	      rank = c->as ? c->as->rank : 0;
-	      tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank);
+	      if (c->attr.codimension)
+		tmp = gfc_copy_allocatable_data (dcmp, comp, ctype, rank);
+	      else
+		tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank);
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 
@@ -6942,10 +6957,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,
+			   bool free_coarray)
 {
   return structure_alloc_comps (der_type, decl, NULL_TREE, rank,
-				DEALLOCATE_ALLOC_COMP);
+				free_coarray ? DEALLOCATE_ALLOC_COMP
+					     : DEALLOCATE_ALLOC_COMP_NO_CAF);
 }
 
 
@@ -7520,7 +7537,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
     {
       int rank;
       rank = sym->as ? sym->as->rank : 0;
-      tmp = gfc_deallocate_alloc_comp (sym->ts.u.derived, descriptor, rank);
+      tmp = gfc_deallocate_alloc_comp (sym->ts.u.derived, descriptor, rank,
+				       true);
       gfc_add_expr_to_block (&cleanup, tmp);
     }
 
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 61f7042..d5b0f2c 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -51,7 +51,7 @@ tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank);
 
 tree gfc_nullify_alloc_comp (gfc_symbol *, tree, int);
 
-tree gfc_deallocate_alloc_comp (gfc_symbol *, tree, int);
+tree gfc_deallocate_alloc_comp (gfc_symbol *, tree, int, bool);
 
 tree gfc_copy_alloc_comp (gfc_symbol *, tree, tree, int);
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 44363c2..4352bcc 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3384,7 +3384,8 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	  {
 	    tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived,
 					     f->sym->backend_decl,
-					     f->sym->as ? f->sym->as->rank : 0);
+					     f->sym->as ? f->sym->as->rank : 0,
+					     true);
 
 	    if (f->sym->attr.optional
 		|| f->sym->ns->proc_name->attr.entry_master)
@@ -3414,7 +3415,8 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	tmp = gfc_deallocate_alloc_comp (CLASS_DATA (f->sym)->ts.u.derived,
 					 tmp,
 					 CLASS_DATA (f->sym)->as ?
-					 CLASS_DATA (f->sym)->as->rank : 0);
+					 CLASS_DATA (f->sym)->as->rank : 0,
+					 true);
 
 	if (f->sym->attr.optional || f->sym->ns->proc_name->attr.entry_master)
 	  {
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index ea65c02..779b999 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3248,7 +3248,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
       /* Allocated allocatable components of derived types must be
 	 deallocated for non-variable scalars.  Non-variable arrays are
-	 dealt with in trans-array.c(gfc_conv_array_parameter).  */
+	 dealt with in trans-array.c(gfc_conv_array_parameter). For coarrays,
+	 the LHS and RHS must have the same allocation status and shape/type
+	 parameters, cf. F2008, 7.2.1.2.  */
       if (e && e->ts.type == BT_DERIVED
 	    && e->ts.u.derived->attr.alloc_comp
 	    && !(e->symtree && e->symtree->n.sym->attr.pointer)
@@ -3277,11 +3279,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	    {
 	      tree local_tmp;
 	      local_tmp = gfc_evaluate_now (tmp, &se->pre);
-	      local_tmp = gfc_copy_alloc_comp (e->ts.u.derived, local_tmp, tmp, parm_rank);
+	      local_tmp = gfc_copy_alloc_comp (e->ts.u.derived, local_tmp, tmp,
+					       parm_rank);
 	      gfc_add_expr_to_block (&se->post, local_tmp);
 	    }
 
-	  tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank);
+	  tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank,
+					   true);
 
 	  gfc_add_expr_to_block (&se->post, tmp);
         }
@@ -5436,7 +5440,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
       if (!l_is_temp && dealloc)
 	{
 	  tmp = gfc_evaluate_now (lse->expr, &lse->pre);
-	  tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0);
+	  tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0, false);
 	  if (r_is_var)
 	    tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
 			    tmp);
@@ -5752,7 +5756,7 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
     {
       tree tmp;
       tmp = gfc_deallocate_alloc_comp (expr1->ts.u.derived, se.expr,
-				       expr1->rank);
+				       expr1->rank, false);
       gfc_add_expr_to_block (&se.pre, tmp);
     }
 
@@ -6247,7 +6251,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
 		       && expr1->rank && !expr2->rank);
   if (scalar_to_array && dealloc)
     {
-      tmp = gfc_deallocate_alloc_comp (expr2->ts.u.derived, rse.expr, 0);
+      tmp = gfc_deallocate_alloc_comp (expr2->ts.u.derived, rse.expr, 0,
+				       false);
       gfc_add_expr_to_block (&loop.post, tmp);
     }
 
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 7d8b4e0..4cd1462 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5157,7 +5157,7 @@ gfc_trans_deallocate (gfc_code *code)
 		    && !(!last && expr->symtree->n.sym->attr.pointer))
 		{
 		  tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, se.expr,
-						  expr->rank);
+						  expr->rank, true);
 		  gfc_add_expr_to_block (&se.pre, tmp);
 		}
 	    }
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 4a71c43..6834861 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -955,7 +955,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, bool can_fail,
   if (ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp)
     {
       tmp = build_fold_indirect_ref_loc (input_location, pointer);
-      tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0);
+      tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0, true);
       gfc_add_expr_to_block (&non_null, tmp);
     }
   else if (ts.type == BT_CLASS
@@ -963,7 +963,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, bool can_fail,
     {
       tmp = build_fold_indirect_ref_loc (input_location, pointer);
       tmp = gfc_deallocate_alloc_comp (ts.u.derived->components->ts.u.derived,
-				       tmp, 0);
+				       tmp, 0, true);
       gfc_add_expr_to_block (&non_null, tmp);
     }