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: r152445

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 12445ef8cd373c5ad68a20cddb6be33a9b7e8409..69ed7b0673da3f77161cba063653a0a85cd43217 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2009-10-05  Tobias Burnus  <burnus@net-b.de>
+
+       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  <burnus@net-b.de>
 
        PR fortran/41515

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index e6da20c21877640640b04d75da77c76b76172bab..a8c1c8e043e3f94cc349d85638abef227858d650 100644 (file)
--- 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 23720aec057a15b5861ee39154d5ac1ebcac8ac1..2d5c6a8ca3d8c74ede949742372b726c71e47e92 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/intent_out_5.f90 b/gcc/testsuite/gfortran.dg/intent_out_5.f90
new file mode 100644 (file)
index 0000000..acd2b60
--- /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