re PR fortran/25217 (Derived type dummy argument having intent(out) attribute)

fortran/
2006-08-19  Erik Edelmann  <eedelman@gcc.gnu.org>

        PR fortran/25217
        * resolve.c (resolve_fl_variable): Set a default initializer for
        derived types with INTENT(OUT) even if 'flag' is true.
        * trans-expr.c (gfc_conv_function_call): Insert code to
        reinitialize INTENT(OUT) arguments of derived type with default
        initializers.


testsuite/
2006-08-19  Erik Edelmann  <eedelman@gcc.gnu.org>

        PR fortran/25217
        * gfortran.dg/derived_init_2.f90: New.

From-SVN: r116261

gcc/fortran/ChangeLog

+2006-08-19  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/25217
+	* resolve.c (resolve_fl_variable): Set a default initializer for
+	derived types with INTENT(OUT) even if 'flag' is true.
+	* trans-expr.c (gfc_conv_function_call): Insert code to
+	reinitialize INTENT(OUT) arguments of derived type with default
+	initializers.
+
 2006-08-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/25828

gcc/fortran/resolve.c

@@ -5232,8 +5232,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
     }
 
   /* Assign default initializer.  */
-  if (sym->ts.type == BT_DERIVED && !(sym->value || flag)
-	&& !sym->attr.pointer)
+  if (sym->ts.type == BT_DERIVED && !sym->value && !sym->attr.pointer
+      && !sym->attr.allocatable && (!flag || sym->attr.intent == INTENT_OUT))
     sym->value = gfc_default_initializer (&sym->ts);
 
   return SUCCESS;

gcc/fortran/trans-expr.c

@@ -2014,6 +2014,16 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
       gfc_add_block_to_block (&se->pre, &parmse.pre);
       gfc_add_block_to_block (&post, &parmse.post);
 
+      /* If an INTENT(OUT) dummy of derived type has a default
+	 initializer, it must be (re)initialized here.  */
+      if (fsym && fsym->attr.intent == INTENT_OUT && fsym->ts.type == BT_DERIVED
+          && fsym->value)
+	{
+	  gcc_assert (!fsym->attr.allocatable);
+	  tmp = gfc_trans_assignment (e, fsym->value);
+	  gfc_add_expr_to_block (&se->pre, tmp);
+	}
+
       /* Character strings are passed as two parameters, a length and a
          pointer.  */
       if (parmse.string_length != NULL_TREE)

gcc/testsuite/ChangeLog

+2006-08-19  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/25217
+	* gfortran.dg/derived_init_2.f90: New.
+
 2006-08-17  J"orn Rennecke  <joern.rennecke@st.com>
 
 	* gcc.c-torture/execute/pr28289.c: New test.

gcc/testsuite/gfortran.dg/derived_init_2.f90

+! { dg-do run }
+! PR 25217: INTENT(OUT) dummies of derived type with default initializers shall
+! be (re)initialized upon procedure entry, unless they are ALLOCATABLE.
+program main
+
+    implicit none
+
+    type :: drv
+        integer :: a(3) = [ 1, 2, 3 ]
+        character(3) :: s = "abc"
+        real, pointer :: p => null()
+    end type drv
+    type(drv) :: aa
+    type(drv), allocatable :: ab(:)
+    real, target :: x
+
+    aa%a = [ 4, 5, 6]
+    aa%s = "def"
+    aa%p => x
+    call sub(aa)
+
+    call sub2(ab)
+
+contains
+
+    subroutine sub(fa)
+        type(drv), intent(out) :: fa
+
+        if (any(fa%a /= [ 1, 2, 3 ])) call abort()
+        if (fa%s /= "abc") call abort()
+        if (associated(fa%p)) call abort()
+    end subroutine sub
+
+    subroutine sub2(fa)
+        type(drv), allocatable, intent(out) :: fa(:)
+    end subroutine sub2
+
+end program main