2015-10-18 Paul Thomas <pault@gcc.gnu.org>

[thirdparty/gcc.git] / gcc / fortran / trans-intrinsic.c

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 15ef5608e95630a05560995ba4a1e38729414fdc..d72ea98abf32bf35ad3e90c94897348b409405ec 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -9414,6 +9414,16 @@ conv_intrinsic_move_alloc (gfc_code *code)
            }
        }
 
+      if (to_expr->ts.type == BT_CHARACTER && to_expr->ts.deferred)
+       {
+         gfc_add_modify_loc (input_location, &block, to_se.string_length,
+                             fold_convert (TREE_TYPE (to_se.string_length),
+                                           from_se.string_length));
+         if (from_expr->ts.deferred)
+           gfc_add_modify_loc (input_location, &block, from_se.string_length,
+                       build_int_cst (TREE_TYPE (from_se.string_length), 0));
+       }
+
       return gfc_finish_block (&block);
     }
 
@@ -9513,6 +9523,14 @@ conv_intrinsic_move_alloc (gfc_code *code)
     }
   else
     {
+      if (to_expr->ts.type == BT_DERIVED
+         && to_expr->ts.u.derived->attr.alloc_comp)
+       {
+         tmp = gfc_deallocate_alloc_comp (to_expr->ts.u.derived,
+                                          to_se.expr, to_expr->rank);
+         gfc_add_expr_to_block (&block, tmp);
+       }
+
       tmp = gfc_conv_descriptor_data_get (to_se.expr);
       tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, NULL_TREE,
                                        NULL_TREE, true, to_expr, false);
@@ -9527,6 +9545,17 @@ conv_intrinsic_move_alloc (gfc_code *code)
   gfc_add_modify_loc (input_location, &block, tmp,
                      fold_convert (TREE_TYPE (tmp), null_pointer_node));
 
+
+  if (to_expr->ts.type == BT_CHARACTER && to_expr->ts.deferred)
+    {
+      gfc_add_modify_loc (input_location, &block, to_se.string_length,
+                         fold_convert (TREE_TYPE (to_se.string_length),
+                                       from_se.string_length));
+      if (from_expr->ts.deferred)
+        gfc_add_modify_loc (input_location, &block, from_se.string_length,
+                       build_int_cst (TREE_TYPE (from_se.string_length), 0));
+    }
+
   return gfc_finish_block (&block);
 }