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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aacdc11..c922b8d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+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

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index cb45a2b..5c9786b 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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;

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index d536dcd..4225b69 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/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)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index cd8b9ab..6f8ae4d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.

diff --git a/gcc/testsuite/gfortran.dg/derived_init_2.f90 b/gcc/testsuite/gfortran.dg/derived_init_2.f90
new file mode 100644 (file)
index 0000000..381f13a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_init_2.f90
@@ -0,0 +1,38 @@
+! { 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