2010-09-02 Tobias Burnus <burnus@net-b.de>

        PR fortran/45489
        * resolve.c (apply_default_init): Mark symbol as referenced,
        if it is initialized.
        (resolve_symbol): Change intialized check for BT_DERIVED such
        that also function results get initialized; remove now obsolete
        gfc_set_sym_referenced for BT_CLASS.

2010-09-02  Tobias Burnus  <burnus@net-b.de>

        PR fortran/45489
        * gfortran.dg/initialization_27.f90: New.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7169de8..fb1fa4d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2010-09-02  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/45489
+       * resolve.c (apply_default_init): Mark symbol as referenced,
+       if it is initialized.
+       (resolve_symbol): Change intialized check for BT_DERIVED such
+       that also function results get initialized; remove now obsolete
+       gfc_set_sym_referenced for BT_CLASS.
+
 2010-09-01  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/44541

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b6980a6..26175e4 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9476,6 +9476,7 @@ apply_default_init (gfc_symbol *sym)
     return;
 
   build_init_assign (sym, init);
+  sym->attr.referenced = 1;
 }
 
 /* Build an initializer for a local integer, real, complex, logical, or
@@ -12148,7 +12149,6 @@ resolve_symbol (gfc_symbol *sym)
      described in 14.7.5, to those variables that have not already
      been assigned one.  */
   if (sym->ts.type == BT_DERIVED
-      && sym->attr.referenced
       && sym->ns == gfc_current_ns
       && !sym->value
       && !sym->attr.allocatable
@@ -12158,6 +12158,7 @@ resolve_symbol (gfc_symbol *sym)
 
       if ((!a->save && !a->dummy && !a->pointer
           && !a->in_common && !a->use_assoc
+          && (a->referenced || a->result)
           && !(a->function && sym != sym->result))
          || (a->dummy && a->intent == INTENT_OUT && !a->pointer))
        apply_default_init (sym);
@@ -12166,10 +12167,7 @@ resolve_symbol (gfc_symbol *sym)
   if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns
       && sym->attr.dummy && sym->attr.intent == INTENT_OUT
       && !sym->attr.pointer && !sym->attr.allocatable)
-    {
-      apply_default_init (sym);
-      gfc_set_sym_referenced (sym);
-    }
+    apply_default_init (sym);
 
   /* If this symbol has a type-spec, check it.  */
   if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 03c55d0..d6b58a6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-09-02  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/45489
+       * gfortran.dg/initialization_27.f90: New.
+
 2010-09-02  Ira Rosen  <irar@il.ibm.com>
 
        * gcc.dg/vect/bb-slp-8.c: Separate the interesting part and the

diff --git a/gcc/testsuite/gfortran.dg/initialization_27.f90 b/gcc/testsuite/gfortran.dg/initialization_27.f90
new file mode 100644 (file)
index 0000000..680a457
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/initialization_27.f90
@@ -0,0 +1,39 @@
+! { dg-do run}
+!
+! PR fortran/45489
+!
+! Check that non-referenced variables are default
+! initialized if they are INTENT(OUT) or function results.
+! Only the latter (i.e. "x=f()") was not working before
+! PR 45489 was fixed.
+!
+program test_init
+  implicit none
+  integer, target :: tgt
+  type A
+    integer, pointer:: p => null ()
+    integer:: i=3
+  end type A
+  type(A):: x, y(3)
+  x=f()
+  if (associated(x%p) .or. x%i /= 3) call abort ()
+  y(1)%p => tgt
+  y%i = 99
+  call sub1(3,y)
+  if (associated(y(1)%p) .or. any(y(:)%i /= 3)) call abort ()
+  y(1)%p => tgt
+  y%i = 99
+  call sub2(y)
+  if (associated(y(1)%p) .or. any(y(:)%i /= 3)) call abort ()
+contains
+ function f() result (fr)
+    type(A):: fr
+ end function f
+ subroutine sub1(n,x)
+   integer :: n
+   type(A), intent(out) :: x(n:n+2)
+ end subroutine sub1
+ subroutine sub2(x)
+   type(A), intent(out) :: x(:)
+ end subroutine sub2
+end program test_init