diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 64 |
2 files changed, 52 insertions, 21 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f35b0dc9456..5af0989013d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,14 @@ 2007-10-02 Paul Thomas <pault@gcc.gnu.org> + PR fortran/33554 + * trans-decl.c (init_intent_out_dt): New function. + (gfc_trans_deferred_vars): Remove the code for default + initialization of INTENT(OUT) derived types and put it + in the new function. Call it earlier than before, so + that array offsets and lower bounds are available. + +2007-10-02 Paul Thomas <pault@gcc.gnu.org> + PR fortran/33550 * decl.c (get_proc_name): Return rc if rc is non-zero; ie. if the name is a reference to an ambiguous symbol. diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index e27a04bd4c7..f04a4d1b904 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2558,6 +2558,44 @@ gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body) } +/* Initialize INTENT(OUT) derived type dummies. */ +static tree +init_intent_out_dt (gfc_symbol * proc_sym, tree body) +{ + stmtblock_t fnblock; + gfc_formal_arglist *f; + gfc_expr *tmpe; + tree tmp; + tree present; + + gfc_init_block (&fnblock); + + for (f = proc_sym->formal; f; f = f->next) + { + if (f->sym && f->sym->attr.intent == INTENT_OUT + && f->sym->ts.type == BT_DERIVED + && !f->sym->ts.derived->attr.alloc_comp + && f->sym->value) + { + gcc_assert (!f->sym->attr.allocatable); + gfc_set_sym_referenced (f->sym); + tmpe = gfc_lval_expr_from_sym (f->sym); + tmp = gfc_trans_assignment (tmpe, f->sym->value, false); + + present = gfc_conv_expr_present (f->sym); + tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, + tmp, build_empty_stmt ()); + gfc_add_expr_to_block (&fnblock, tmp); + gfc_free_expr (tmpe); + } + } + + gfc_add_expr_to_block (&fnblock, body); + return gfc_finish_block (&fnblock); +} + + + /* Generate function entry and exit code, and add it to the function body. This includes: Allocation and initialization of array variables. @@ -2612,6 +2650,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) && proc_sym->ts.type == BT_COMPLEX); } + /* Initialize the INTENT(OUT) derived type dummy arguments. This + should be done here so that the offsets and lbounds of arrays + are available. */ + fnbody = init_intent_out_dt (proc_sym, fnbody); + for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink) { bool sym_has_alloc_comp = (sym->ts.type == BT_DERIVED) @@ -2710,27 +2753,6 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) if (TREE_CODE (f->sym->ts.cl->backend_decl) == PARM_DECL) gfc_trans_vla_type_sizes (f->sym, &body); } - - /* If an INTENT(OUT) dummy of derived type has a default - initializer, it must be initialized here. */ - if (f->sym && f->sym->attr.intent == INTENT_OUT - && f->sym->ts.type == BT_DERIVED - && !f->sym->ts.derived->attr.alloc_comp - && f->sym->value) - { - gfc_expr *tmpe; - tree tmp, present; - gcc_assert (!f->sym->attr.allocatable); - gfc_set_sym_referenced (f->sym); - tmpe = gfc_lval_expr_from_sym (f->sym); - tmp = gfc_trans_assignment (tmpe, f->sym->value, false); - - present = gfc_conv_expr_present (f->sym); - tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, - tmp, build_empty_stmt ()); - gfc_add_expr_to_block (&body, tmp); - gfc_free_expr (tmpe); - } } if (gfc_return_by_reference (proc_sym) && proc_sym->ts.type == BT_CHARACTER |