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

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.

From-SVN: r152407

gcc/fortran/ChangeLog

+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

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);
       }
 

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/intent_out_5.f90

+! { 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