procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/57596 (Wrong code for allocatable deferred-length strings)

Browse source 
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
This commit is contained in:
Tobias Burnus 2013-06-14 09:41:42 +02:00 • committed by Tobias Burnus
parent 366a1bc6b2
commit 48f316eafe
4 changed files with 73 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View file

@ -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

48
gcc/fortran/trans-decl.c
View file

@ -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;
}

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2013-06-14 Tobias Burnus <burnus@net-b.de>
PR fortran/57596
* gfortran.dg/deferred_type_param_9.f90: New.
2013-06-13 Marc Glisse <marc.glisse@inria.fr>
* gcc.dg/fold-minus-1.c: New testcase.

22
gcc/testsuite/gfortran.dg/deferred_type_param_9.f90 Normal file
View file

@ -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