[multiple changes]

[gcc.git] / gcc / fortran / trans-decl.c

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 43e27ee43e208366284693fc8a6807f4bfb21bae..4d410b101a7fbd8f47436112798f890614895787 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -964,6 +964,9 @@ gfc_get_symbol_decl (gfc_symbol * sym)
        GFC_DECL_PACKED_ARRAY (decl) = 1;
     }
 
+  if (sym->ts.type == BT_DERIVED && sym->ts.derived->attr.alloc_comp)
+    gfc_defer_symbol_init (sym);
+
   gfc_finish_var_decl (decl, sym);
 
   if (sym->ts.type == BT_CHARACTER)
@@ -2572,6 +2575,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
 
   for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
     {
+      bool sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)
+                                  && sym->ts.derived->attr.alloc_comp;
       if (sym->attr.dimension)
        {
          switch (sym->as->type)
@@ -2614,13 +2619,18 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
              break;
 
            case AS_DEFERRED:
-             fnbody = gfc_trans_deferred_array (sym, fnbody);
+             if (!sym_has_alloc_comp)
+               fnbody = gfc_trans_deferred_array (sym, fnbody);
              break;
 
            default:
              gcc_unreachable ();
            }
+         if (sym_has_alloc_comp)
+           fnbody = gfc_trans_deferred_array (sym, fnbody);
        }
+      else if (sym_has_alloc_comp)
+       fnbody = gfc_trans_deferred_array (sym, fnbody);
       else if (sym->ts.type == BT_CHARACTER)
        {
          gfc_get_backend_locus (&loc);
@@ -2972,10 +2982,12 @@ gfc_generate_function_code (gfc_namespace * ns)
   tree old_context;
   tree decl;
   tree tmp;
+  tree tmp2;
   stmtblock_t block;
   stmtblock_t body;
   tree result;
   gfc_symbol *sym;
+  int rank;
 
   sym = ns->proc_name;
 
@@ -3135,7 +3147,6 @@ gfc_generate_function_code (gfc_namespace * ns)
   tmp = gfc_finish_block (&body);
   /* Add code to create and cleanup arrays.  */
   tmp = gfc_trans_deferred_vars (sym, tmp);
-  gfc_add_expr_to_block (&block, tmp);
 
   if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
     {
@@ -3150,7 +3161,18 @@ gfc_generate_function_code (gfc_namespace * ns)
       else
        result = sym->result->backend_decl;
 
-      if (result == NULL_TREE)
+      if (result != NULL_TREE && sym->attr.function
+           && sym->ts.type == BT_DERIVED
+           && sym->ts.derived->attr.alloc_comp)
+       {
+         rank = sym->as ? sym->as->rank : 0;
+         tmp2 = gfc_nullify_alloc_comp (sym->ts.derived, result, rank);
+         gfc_add_expr_to_block (&block, tmp2);
+       }
+
+     gfc_add_expr_to_block (&block, tmp);
+
+     if (result == NULL_TREE)
        warning (0, "Function return value not set");
       else
        {
@@ -3161,6 +3183,9 @@ gfc_generate_function_code (gfc_namespace * ns)
          gfc_add_expr_to_block (&block, tmp);
        }
     }
+  else
+    gfc_add_expr_to_block (&block, tmp);
+
 
   /* Add all the decls we created during processing.  */
   decl = saved_function_decls;