A rather simple patch. I wonder why we didn't get in trouble before -
the "*dummy = NULL;" part should affect also other optional allocatable
dummy arguments.
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
PS: Pending patches:
* Unreviewed: Print exception status at STOP,
http://gcc.gnu.org/ml/fortran/2013-06/msg00077.html
* Uncommitted: Mikael's CLASS+function patch,
http://gcc.gnu.org/ml/fortran/2013-06/msg00079.html
PPS: The old dump (GCC 4.8, 4.9 w/o patch should be the same) produced:
get (character(kind=1)[1:(integer(kind=4)) _c_val] * * c_val,
integer(kind=4) * _c_val)
{
*c_val = 0B;
...
finally
{
*_c_val = .c_val;
}
}
and with intent(inout):
.c_val = *_c_val;
2013-06-13 Tobias Burnus <bur...@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 Tobias Burnus <bur...@net-b.de>
PR fortran/57596
* gfortran.dg/deferred_type_param_9.f90: New.
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 87652ba..300175f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3855,12 +3857,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 +3885,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;
}
--- /dev/null 2013-06-13 09:10:45.615178715 +0200
+++ gcc/gcc/testsuite/gfortran.dg/deferred_type_param_9.f90 2013-06-13 10:55:51.506836678 +0200
@@ -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