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

re PR fortran/41479 (intent(out) for types with default initialization) 

2009-10-05  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41479
        (init_intent_out_dt): Call gfc_init_default_dt
        for all derived types with initializers.

2009-10-05  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41479
        * gfortran.dg/intent_out_5.f90: New test.

From-SVN: r152444
This commit is contained in:
Tobias Burnus 2009-10-05 11:19:13 +02:00 committed by Tobias Burnus
parent ddc90f8f09
commit 0c05b956ef
4 changed files with 40 additions and 4 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-10-05 Tobias Burnus <burnus@net-b.de>
PR fortran/41479
(init_intent_out_dt): Call gfc_init_default_dt
for all derived types with initializers.
2009-10-01 Tobias Burnus <burnus@net-b.de>
PR fortran/41515

6
gcc/fortran/trans-decl.c
View File

@ -2829,7 +2829,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body)
&& !f->sym->attr.pointer
&& f->sym->ts.type == BT_DERIVED)
{
if (f->sym->ts.derived->attr.alloc_comp)
if (f->sym->ts.derived->attr.alloc_comp && !f->sym->value)
{
tmp = gfc_deallocate_alloc_comp (f->sym->ts.derived,
f->sym->backend_decl,
@ -2841,9 +2841,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body)
gfc_add_expr_to_block (&fnblock, tmp);
}
if (!f->sym->ts.derived->attr.alloc_comp
&& f->sym->value)
else if (f->sym->value)
body = gfc_init_default_dt (f->sym, body);
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2009-10-05 Tobias Burnus <burnus@net-b.de>
PR fortran/41479
* gfortran.dg/intent_out_5.f90: New test.
2009-10-01 Tobias Burnus <burnus@net-b.de>
PR fortran/41515

27
gcc/testsuite/gfortran.dg/intent_out_5.f90 Normal file
View File

@ -0,0 +1,27 @@
! { dg-do run}
!
! PR fortran/41479
!
! Contributed by Juergen Reuter.
!
program main
type :: container_t
integer :: n = 42
! if the following line is omitted, the problem disappears
integer, dimension(:), allocatable :: a
end type container_t
type(container_t) :: container
if (container%n /= 42) call abort()
if (allocated(container%a)) call abort()
container%n = 1
allocate(container%a(50))
call init (container)
if (container%n /= 42) call abort()
if (allocated(container%a)) call abort()
contains
subroutine init (container)
type(container_t), intent(out) :: container
end subroutine init
end program main