[Bug fortran/45489] Default initialization of derived-type function result missing

[burnus at gcc dot gnu dot org]

------- Comment #3 from burnus at gcc dot gnu dot org  2010-09-02 07:31 -------
(In reply to comment #2)
> It seems to work if one adds
>           if (!a->referenced && sym->value)
>             gfc_set_sym_referenced (sym);

As gfortran does not use a static initializer via sym->value but an assignment,
this check does not work.

The following patch should work:
----------------------------------------
--- resolve.c   (revision 163759)
+++ resolve.c   (working copy)
@@ -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


Extended test case

Note, I failed to create a failing dummy test case. Seemingly, "sym->value" is
set for the dummies below; thus, only the "f" part of the test case is failing
without the patch above.
------------------
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


-- 

burnus at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|unassigned at gcc dot gnu   |burnus at gcc dot gnu dot
                   |dot org                     |org
             Status|UNCONFIRMED                 |ASSIGNED
     Ever Confirmed|0                           |1
   Last reconfirmed|0000-00-00 00:00:00         |2010-09-02 07:31:51
               date|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45489