diff options
| author | Tobias Burnus <burnus@net-b.de> | 2013-06-14 09:41:42 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-06-14 09:41:42 +0200 |
| commit | 48f316eafeb6fa1196298313a03783901c00782b (patch) | |
| tree | 4304ffac3b4a75f73e74a464366705dcf939ae47 /gcc/fortran | |
| parent | 366a1bc6b266446d978a097a1d6dba0020b6539b (diff) | |
| download | gcc-48f316eafeb6fa1196298313a03783901c00782b.zip gcc-48f316eafeb6fa1196298313a03783901c00782b.tar.gz gcc-48f316eafeb6fa1196298313a03783901c00782b.tar.bz2 | |
re PR fortran/57596 (Wrong code for allocatable deferred-length strings)
2013-06-14 Tobias Burnus <burnus@net-b.de>
PR fortran/57596
* trans-decl.c (gfc_trans_deferred_vars): Honor OPTIONAL
for nullify and deferred-strings' length variable.
2013-06-14 Tobias Burnus <burnus@net-b.de>
PR fortran/57596
* gfortran.dg/deferred_type_param_9.f90: New.
From-SVN: r200084
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 48 |
2 files changed, 46 insertions, 8 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cd491a0..07ab220 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2013-06-14 Tobias Burnus <burnus@net-b.de> + + PR fortran/57596 + * trans-decl.c (gfc_trans_deferred_vars): Honor OPTIONAL + for nullify and deferred-strings' length variable. + 2013-06-13 Mikael Morin <mikael@gcc.gnu.org> PR fortran/49074 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 87652ba..f04ebdc 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3855,12 +3855,21 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT) { /* Nullify when entering the scope. */ - gfc_add_modify (&init, se.expr, - fold_convert (TREE_TYPE (se.expr), - null_pointer_node)); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (se.expr), se.expr, + fold_convert (TREE_TYPE (se.expr), + null_pointer_node)); + if (sym->attr.optional) + { + tree present = gfc_conv_expr_present (sym); + tmp = build3_loc (input_location, COND_EXPR, + void_type_node, present, tmp, + build_empty_stmt (input_location)); + } + gfc_add_expr_to_block (&init, tmp); } - if ((sym->attr.dummy ||sym->attr.result) + if ((sym->attr.dummy || sym->attr.result) && sym->ts.type == BT_CHARACTER && sym->ts.deferred) { @@ -3874,15 +3883,38 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) gfc_add_modify (&init, sym->ts.u.cl->backend_decl, build_int_cst (gfc_charlen_type_node, 0)); else - gfc_add_modify (&init, sym->ts.u.cl->backend_decl, tmp); + { + tree tmp2; + + tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, + gfc_charlen_type_node, + sym->ts.u.cl->backend_decl, tmp); + if (sym->attr.optional) + { + tree present = gfc_conv_expr_present (sym); + tmp2 = build3_loc (input_location, COND_EXPR, + void_type_node, present, tmp2, + build_empty_stmt (input_location)); + } + gfc_add_expr_to_block (&init, tmp2); + } gfc_restore_backend_locus (&loc); /* Pass the final character length back. */ if (sym->attr.intent != INTENT_IN) - tmp = fold_build2_loc (input_location, MODIFY_EXPR, - gfc_charlen_type_node, tmp, - sym->ts.u.cl->backend_decl); + { + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + gfc_charlen_type_node, tmp, + sym->ts.u.cl->backend_decl); + if (sym->attr.optional) + { + tree present = gfc_conv_expr_present (sym); + tmp = build3_loc (input_location, COND_EXPR, + void_type_node, present, tmp, + build_empty_stmt (input_location)); + } + } else tmp = NULL_TREE; } |