2013-03-31 Tobias Burnus <burnus@net-b.de>

        * class.c (finalization_scalarizer,
        * finalizer_insert_packed_call,
        generate_finalization_wrapper): Avoid segfault with absent SIZE=
        argment to TRANSFER and use correct result kind for SIZE.
        * intrinsic.c (gfc_isym_id_by_intmod): Also handle ids of
        nonmodules.
        * trans.c (gfc_build_final_call): Handle coarrays.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@197281 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 16 insertions, 7 deletions

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index d7bdf268a37..8211573e1b3 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1031,6 +1031,7 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
   stmtblock_t block;
   gfc_se se;
   tree final_fndecl, array, size, tmp;
+  symbol_attribute attr;
 
   gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
   gcc_assert (var);
@@ -1041,6 +1042,8 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
   if (POINTER_TYPE_P (TREE_TYPE (final_fndecl)))
     final_fndecl = build_fold_indirect_ref_loc (input_location, final_fndecl);
 
+  attr = gfc_expr_attr (var);
+
   if (ts.type == BT_DERIVED)
     {
       tree elem_size;
@@ -1052,8 +1055,12 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
 
       gfc_init_se (&se, NULL);
       se.want_pointer = 1;
-      if (var->rank || gfc_expr_attr (var).dimension)
+      if (var->rank || attr.dimension
+	  || (attr.codimension && attr.allocatable
+	      && gfc_option.coarray == GFC_FCOARRAY_LIB))
 	{
+	  if (var->rank == 0)
+	    se.want_coarray = 1;
 	  se.descriptor_only = 1;
 	  gfc_conv_expr_descriptor (&se, var);
 	  array = se.expr;
@@ -1062,7 +1069,6 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
 	}
       else
 	{
-	  symbol_attribute attr;
 	  gfc_clear_attr (&attr);
 	  gfc_conv_expr (&se, var);
 	  gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
@@ -1087,22 +1093,25 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
       size = se.expr;
 
       array_expr = gfc_copy_expr (var);
-      gfc_add_data_component (array_expr);
       gfc_init_se (&se, NULL);
       se.want_pointer = 1;
-      if (array_expr->rank || gfc_expr_attr (array_expr).dimension)
+      if (array_expr->rank || attr.dimension
+	  || (attr.codimension && attr.allocatable
+	      && gfc_option.coarray == GFC_FCOARRAY_LIB))
 	{
+	  gfc_add_class_array_ref (array_expr);
+	  if (array_expr->rank == 0)
+	    se.want_coarray = 1;
 	  se.descriptor_only = 1;
-	  gfc_conv_expr_descriptor (&se, var);
+	  gfc_conv_expr_descriptor (&se, array_expr);
 	  array = se.expr;
 	  if (! POINTER_TYPE_P (TREE_TYPE (array)))
 	    array = gfc_build_addr_expr (NULL, array);
 	}
       else
 	{
-	  symbol_attribute attr;
-
 	  gfc_clear_attr (&attr);
+	  gfc_add_data_component (array_expr);
 	  gfc_conv_expr (&se, array_expr);
 	  gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
 	  array = se.expr;