diff options
Diffstat (limited to 'gcc/fortran/trans-decl.c')
| -rw-r--r-- | gcc/fortran/trans-decl.c | 31 |
1 files changed, 28 insertions, 3 deletions
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 43e27ee..4d410b1 100644 --- 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; |