re PR fortran/33554 (Seg.fault: Default initialization of derived type uses uninitial...

2007-10-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33554
	* trans-decl.c (init_intent_out_dt): New function.
	(gfc_trans_deferred_vars): Remove the code for default
	initialization of INTENT(OUT) derived types and put it
	in the new function.  Call it earlier than before, so
	that array offsets and lower bounds are available.

2007-10-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33554
	* gfortran.dg/intent_out_2.f90: New test.

From-SVN: r128950

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f35b0dc945655b2879516b39a16818ec7f9f37d2..5af0989013d2e51f042944f058ba0a20f6762203 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2007-10-02  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/33554
+       * trans-decl.c (init_intent_out_dt): New function.
+       (gfc_trans_deferred_vars): Remove the code for default
+       initialization of INTENT(OUT) derived types and put it
+       in the new function.  Call it earlier than before, so
+       that array offsets and lower bounds are available.
+
 2007-10-02  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/33550

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index e27a04bd4c72efc7f911c5d19b9dd427c03d7c00..f04a4d1b90402fce18cf4eea03dd09cf4400f89f 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2558,6 +2558,44 @@ gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body)
 }
 
 
+/* Initialize INTENT(OUT) derived type dummies.  */
+static tree
+init_intent_out_dt (gfc_symbol * proc_sym, tree body)
+{
+  stmtblock_t fnblock;
+  gfc_formal_arglist *f;
+  gfc_expr *tmpe;
+  tree tmp;
+  tree present;
+
+  gfc_init_block (&fnblock);
+
+  for (f = proc_sym->formal; f; f = f->next)
+    {
+      if (f->sym && f->sym->attr.intent == INTENT_OUT
+           && f->sym->ts.type == BT_DERIVED
+           && !f->sym->ts.derived->attr.alloc_comp
+           && f->sym->value)
+       {
+         gcc_assert (!f->sym->attr.allocatable);
+         gfc_set_sym_referenced (f->sym);
+         tmpe = gfc_lval_expr_from_sym (f->sym);
+         tmp = gfc_trans_assignment (tmpe, f->sym->value, false);
+
+         present = gfc_conv_expr_present (f->sym);
+         tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present,
+                       tmp, build_empty_stmt ());
+         gfc_add_expr_to_block (&fnblock, tmp);
+         gfc_free_expr (tmpe);
+       }
+    }
+
+  gfc_add_expr_to_block (&fnblock, body);
+  return gfc_finish_block (&fnblock);
+}
+
+
+
 /* Generate function entry and exit code, and add it to the function body.
    This includes:
     Allocation and initialization of array variables.
@@ -2612,6 +2650,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
                    && proc_sym->ts.type == BT_COMPLEX);
     }
 
+  /* Initialize the INTENT(OUT) derived type dummy arguments.  This
+     should be done here so that the offsets and lbounds of arrays
+     are available.  */
+  fnbody = init_intent_out_dt (proc_sym, fnbody);
+
   for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
     {
       bool sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)
@@ -2710,27 +2753,6 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
          if (TREE_CODE (f->sym->ts.cl->backend_decl) == PARM_DECL)
            gfc_trans_vla_type_sizes (f->sym, &body);
        }
-
-      /* If an INTENT(OUT) dummy of derived type has a default
-        initializer, it must be initialized here.  */
-      if (f->sym && f->sym->attr.intent == INTENT_OUT
-           && f->sym->ts.type == BT_DERIVED
-           && !f->sym->ts.derived->attr.alloc_comp
-           && f->sym->value)
-       {
-         gfc_expr *tmpe;
-         tree tmp, present;
-         gcc_assert (!f->sym->attr.allocatable);
-         gfc_set_sym_referenced (f->sym);
-         tmpe = gfc_lval_expr_from_sym (f->sym);
-         tmp = gfc_trans_assignment (tmpe, f->sym->value, false);
-
-         present = gfc_conv_expr_present (f->sym);
-         tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present,
-                       tmp, build_empty_stmt ());
-         gfc_add_expr_to_block (&body, tmp);
-         gfc_free_expr (tmpe);
-       }
     }
 
   if (gfc_return_by_reference (proc_sym) && proc_sym->ts.type == BT_CHARACTER

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8bc1d28b99bfb94cbfd15ab24f8362bc4d6c5e34..62187039a5dbf39c6a3c3681e8d411b47f617705 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-10-02  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/33554
+       * gfortran.dg/intent_out_2.f90: New test.
+
 2007-10-02  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/33550

diff --git a/gcc/testsuite/gfortran.dg/intent_out_2.f90 b/gcc/testsuite/gfortran.dg/intent_out_2.f90
index 0fad1b8f3feadf3c305788bcec13514a61863b71..4dc5191e9a21c8244919e30d99853379ca1d075a 100644 (file)
--- a/gcc/testsuite/gfortran.dg/intent_out_2.f90
+++ b/gcc/testsuite/gfortran.dg/intent_out_2.f90
@@ -1,47 +1,47 @@
-! { dg-do -run }\r
+! { dg-do run }
 ! Tests the fix for PR33554, in which the default initialization
 ! of temp, in construct_temp, caused a segfault because it was
 ! being done before the array offset and lower bound were
 ! available.
 !
 ! Contributed by Harald Anlauf <anlauf@gmx.de> 
-!\r
-module gfcbug72\r
-  implicit none\r
-\r
-  type t_datum\r
-    character(len=8) :: mn = 'abcdefgh'\r
-  end type t_datum\r
-\r
-  type t_temp\r
-    type(t_datum) :: p\r
-  end type t_temp\r
-\r
-contains\r
-\r
-  subroutine setup ()\r
-    integer :: i\r
-    type (t_temp), pointer :: temp(:) => NULL ()\r
-\r
-    do i=1,2\r
-       allocate (temp (2))\r
-       call construct_temp (temp)\r
-       if (any (temp % p% mn .ne. 'ijklmnop')) call abort ()\r
-       deallocate (temp)\r
-    end do\r
-  end subroutine setup\r
-  !--\r
-  subroutine construct_temp (temp)\r
-    type (t_temp), intent(out) :: temp (:)\r
-    if (any (temp % p% mn .ne. 'abcdefgh')) call abort ()\r
-    temp(:)% p% mn = 'ijklmnop'\r
-  end subroutine construct_temp\r
-end module gfcbug72\r
-\r
-program test\r
-  use gfcbug72\r
-  implicit none\r
-  call setup ()\r
-end program test\r
+!
+module gfcbug72
+  implicit none
+
+  type t_datum
+    character(len=8) :: mn = 'abcdefgh'
+  end type t_datum
+
+  type t_temp
+    type(t_datum) :: p
+  end type t_temp
+
+contains
+
+  subroutine setup ()
+    integer :: i
+    type (t_temp), pointer :: temp(:) => NULL ()
+
+    do i=1,2
+       allocate (temp (2))
+       call construct_temp (temp)
+       if (any (temp % p% mn .ne. 'ijklmnop')) call abort ()
+       deallocate (temp)
+    end do
+  end subroutine setup
+  !--
+  subroutine construct_temp (temp)
+    type (t_temp), intent(out) :: temp (:)
+    if (any (temp % p% mn .ne. 'abcdefgh')) call abort ()
+    temp(:)% p% mn = 'ijklmnop'
+  end subroutine construct_temp
+end module gfcbug72
+
+program test
+  use gfcbug72
+  implicit none
+  call setup ()
+end program test
 ! { dg-final { cleanup-modules "gfcbug72" } }
-\r
+