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

        PR fortran/41479
        * trans-decl.c (gfc_init_default_dt): Check for presence of
        the argument only if it is optional or in entry master.
        (init_intent_out_dt): Ditto; call gfc_init_default_dt
        for all derived types with initializers.

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

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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152407 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 55386ac..c325d25 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2009-10-02  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/41479
+       * trans-decl.c (gfc_init_default_dt): Check for presence of
+       the argument only if it is optional or in entry master.
+       (init_intent_out_dt): Ditto; call gfc_init_default_dt
+       for all derived types with initializers.
+
 2009-10-01  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
 
        PR fortran/33197

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 3d6a5e2..ee38efb 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2991,7 +2991,8 @@ gfc_init_default_dt (gfc_symbol * sym, tree body)
   gfc_set_sym_referenced (sym);
   e = gfc_lval_expr_from_sym (sym);
   tmp = gfc_trans_assignment (e, sym->value, false);
-  if (sym->attr.dummy)
+  if (sym->attr.dummy && (sym->attr.optional
+                         || sym->ns->proc_name->attr.entry_master))
     {
       present = gfc_conv_expr_present (sym);
       tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present,
@@ -3023,21 +3024,23 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body)
        && !f->sym->attr.pointer
        && f->sym->ts.type == BT_DERIVED)
       {
-       if (f->sym->ts.u.derived->attr.alloc_comp)
+       if (f->sym->ts.u.derived->attr.alloc_comp && !f->sym->value)
          {
            tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived,
                                             f->sym->backend_decl,
                                             f->sym->as ? f->sym->as->rank : 0);
 
-           present = gfc_conv_expr_present (f->sym);
-           tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present,
-                         tmp, build_empty_stmt (input_location));
+           if (f->sym->attr.optional
+               || f->sym->ns->proc_name->attr.entry_master)
+             {
+               present = gfc_conv_expr_present (f->sym);
+               tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present,
+                             tmp, build_empty_stmt (input_location));
+             }
 
            gfc_add_expr_to_block (&fnblock, tmp);
          }
-
-       if (!f->sym->ts.u.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 4bbabcb..888064b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-10-02  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/41479
+       * gfortran.dg/intent_out_5.f90: New test.
+
 2009-10-02  Jakub Jelinek  <jakub@redhat.com>
 
        PR debug/41404

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