OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/41850 (Wrong-code with optional allocatable arrays) 

2009-11-01  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41850
        * trans-expr.c (gfc_conv_procedure_call): Deallocate intent-out
        variables only when present.

2009-11-01  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41850
        * gfortran.dg/intent_out_6.f90: New testcase.

From-SVN: r153794
This commit is contained in:
Tobias Burnus 2009-11-01 15:35:40 +01:00 committed by Tobias Burnus
parent 97a9378fd2
commit c478cae2ec
4 changed files with 65 additions and 10 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 @@
2009-11-01 Tobias Burnus <burnus@net-b.de>
PR fortran/41850
* trans-expr.c (gfc_conv_procedure_call): Deallocate intent-out
variables only when present.
2009-10-30 Tobias Burnus <burnus@net-b.de>
PR fortran/41777

25
gcc/fortran/trans-expr.c
View File

@ -2671,16 +2671,21 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
gfc_conv_array_parameter (&parmse, e, argss, f, fsym,
sym->name);
/* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
allocated on entry, it must be deallocated. */
if (fsym && fsym->attr.allocatable
&& fsym->attr.intent == INTENT_OUT)
{
tmp = build_fold_indirect_ref (parmse.expr);
tmp = gfc_trans_dealloc_allocated (tmp);
gfc_add_expr_to_block (&se->pre, tmp);
}
/* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
allocated on entry, it must be deallocated. */
if (fsym && fsym->attr.allocatable
&& fsym->attr.intent == INTENT_OUT)
{
tmp = build_fold_indirect_ref (parmse.expr);
tmp = gfc_trans_dealloc_allocated (tmp);
if (fsym->attr.optional
&& e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.optional)
tmp = fold_build3 (COND_EXPR, void_type_node,
gfc_conv_expr_present (e->symtree->n.sym),
tmp, build_empty_stmt ());
gfc_add_expr_to_block (&se->pre, tmp);
}
}
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2009-11-01 Tobias Burnus <burnus@net-b.de>
PR fortran/41850
* gfortran.dg/intent_out_6.f90: New testcase.
2009-10-31 Jason Merrill <jason@redhat.com>
PR c++/41754

39
gcc/testsuite/gfortran.dg/intent_out_6.f90 Normal file
View File

@ -0,0 +1,39 @@
! { dg-do run }
!
! PR fortran/41850
!
module test_module
implicit none
contains
subroutine sub2(a)
implicit none
real,allocatable,intent(out),optional :: a(:)
if(present(a)) then
if(allocated(a)) call abort()
allocate(a(1))
a(1) = 5
end if
end subroutine sub2
subroutine sub1(a)
implicit none
real,allocatable,intent(out),optional :: a(:)
! print *,'in sub1'
call sub2(a)
if(present(a)) then
if(a(1) /= 5) call abort()
end if
end subroutine sub1
end module test_module
program test
use test_module
implicit none
real, allocatable :: x(:)
allocate(x(1))
call sub1()
x = 8
call sub1(x)
if(x(1) /= 5) call abort()
end program
! { dg-final { cleanup-modules "test_module" } }