From: Tobias Burnus Date: Mon, 5 Oct 2009 09:19:52 +0000 (+0200) Subject: re PR fortran/41479 (intent(out) for types with default initialization) X-Git-Tag: releases/gcc-4.3.5~354 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=2b96188676c259d31ee4b0fecd3e2140818db9aa;p=thirdparty%2Fgcc.git re PR fortran/41479 (intent(out) for types with default initialization) 2009-10-05 Tobias Burnus PR fortran/41479 (init_intent_out_dt): Call gfc_init_default_dt for all derived types with initializers. 2009-10-05 Tobias Burnus PR fortran/41479 * gfortran.dg/intent_out_5.f90: New test. From-SVN: r152445 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 12445ef8cd37..69ed7b0673da 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2009-10-05 Tobias Burnus + + PR fortran/41479 + * trans-decl.c (init_intent_out_dt): Call gfc_init_default_dt + for all derived types with initializers. + 2009-10-01 Tobias Burnus PR fortran/41515 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index e6da20c21877..a8c1c8e043e3 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2607,7 +2607,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, @@ -2619,9 +2619,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); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 23720aec057a..2d5c6a8ca3d8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-10-05 Tobias Burnus + + PR fortran/41479 + * gfortran.dg/intent_out_5.f90: New test. + 2009-10-01 Tobias Burnus PR fortran/41515 diff --git a/gcc/testsuite/gfortran.dg/intent_out_5.f90 b/gcc/testsuite/gfortran.dg/intent_out_5.f90 new file mode 100644 index 000000000000..acd2b6065259 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/intent_out_5.f90 @@ -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