From 48f316eafeb6fa1196298313a03783901c00782b Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 14 Jun 2013 09:41:42 +0200 Subject: [PATCH] re PR fortran/57596 (Wrong code for allocatable deferred-length strings) 2013-06-14 Tobias Burnus PR fortran/57596 * trans-decl.c (gfc_trans_deferred_vars): Honor OPTIONAL for nullify and deferred-strings' length variable. 2013-06-14 Tobias Burnus PR fortran/57596 * gfortran.dg/deferred_type_param_9.f90: New. From-SVN: r200084 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-decl.c | 48 +++++++++++++++---- gcc/testsuite/ChangeLog | 5 ++ .../gfortran.dg/deferred_type_param_9.f90 | 22 +++++++++ 4 files changed, 73 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/deferred_type_param_9.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cd491a09499..07ab2209419 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2013-06-14 Tobias Burnus + + PR fortran/57596 + * trans-decl.c (gfc_trans_deferred_vars): Honor OPTIONAL + for nullify and deferred-strings' length variable. + 2013-06-13 Mikael Morin PR fortran/49074 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 87652bab8ea..f04ebdced0a 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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 39580f76333..0d4c54e2dd6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-06-14 Tobias Burnus + + PR fortran/57596 + * gfortran.dg/deferred_type_param_9.f90: New. + 2013-06-13 Marc Glisse * gcc.dg/fold-minus-1.c: New testcase. diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_9.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_9.f90 new file mode 100644 index 00000000000..a6e685753f4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/deferred_type_param_9.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! +! PR fortran/57596 +! +! Contributed by Valery Weber +! +PROGRAM main + IMPLICIT NONE + call get () + call get2 () +contains + SUBROUTINE get (c_val) + CHARACTER( : ), INTENT( INOUT ), ALLOCATABLE, OPTIONAL :: c_val + CHARACTER( 10 ) :: c_val_tmp + if(present(c_val)) call abort() + END SUBROUTINE get + SUBROUTINE get2 (c_val) + CHARACTER( : ), INTENT( OUT ), ALLOCATABLE, OPTIONAL :: c_val + CHARACTER( 10 ) :: c_val_tmp + if(present(c_val)) call abort() + END SUBROUTINE get2 +END PROGRAM main