------- 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