Dear All,
This patch undoes a side effect of r225447 that had the effect of
eliminating the default intialization of derived type array results.
The patch corrects the offending changes to the condition in resolve_symbol.
Bootstraps and regtests of FC23/x86_64 - OK for trunk, 7- and 6-branches?
Cheers
Paul
2017-10-13 Paul Thomas <[email protected]>
PR fortran/81048
* resolve.c (resolve_symbol): Ensure that derived type array
results get default initialization.
2017-10-13 Paul Thomas <[email protected]>
PR fortran/81048
* gfortran.dg/derived_init_4.f90 : New test.
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 253525)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_symbol (gfc_symbol *sym)
*** 14967,14973 ****
if ((!a->save && !a->dummy && !a->pointer
&& !a->in_common && !a->use_assoc
! && !a->result && !a->function)
|| (a->dummy && a->intent == INTENT_OUT && !a->pointer))
apply_default_init (sym);
else if (a->function && sym->result && a->access != ACCESS_PRIVATE
--- 14967,14978 ----
if ((!a->save && !a->dummy && !a->pointer
&& !a->in_common && !a->use_assoc
! && a->referenced
! && !((a->function || a->result)
! && (!a->dimension
! || sym->ts.u.derived->attr.alloc_comp
! || sym->ts.u.derived->attr.pointer_comp))
! && !(a->function && sym != sym->result))
|| (a->dummy && a->intent == INTENT_OUT && !a->pointer))
apply_default_init (sym);
else if (a->function && sym->result && a->access != ACCESS_PRIVATE
Index: gcc/testsuite/gfortran.dg/derived_init_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/derived_init_4.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/derived_init_4.f90 (working copy)
***************
*** 0 ****
--- 1,59 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR81048, where in the second call to 'g2' the
+ ! default initialization was "forgotten". 'g1', 'g1a' and 'g3' check
+ ! that this does not occur for scalars and explicit results.
+ !
+ ! Contributed by David Smith <[email protected]>
+ !
+ program test
+ type f
+ integer :: f = -1
+ end type
+ type(f) :: a, b(3)
+ type(f), allocatable :: ans
+ b = g2(a)
+ b = g2(a)
+ ans = g1(a)
+ if (ans%f .ne. -1) call abort
+ ans = g1(a)
+ if (ans%f .ne. -1) call abort
+ ans = g1a(a)
+ if (ans%f .ne. -1) call abort
+ ans = g1a(a)
+ if (ans%f .ne. -1) call abort
+ b = g3(a)
+ b = g3(a)
+ contains
+ function g3(a) result(res)
+ type(f) :: a, res(3)
+ do j = 1, 3
+ if (res(j)%f == -1) then
+ res(j)%f = a%f - 1
+ else
+ call abort
+ endif
+ enddo
+ end function g3
+
+ function g2(a)
+ type(f) :: a, g2(3)
+ do j = 1, 3
+ if (g2(j)%f == -1) then
+ g2(j)%f = a%f - 1
+ else
+ call abort
+ endif
+ enddo
+ end function g2
+
+ function g1(a)
+ type(f) :: g1, a
+ if (g1%f .ne. -1 ) call abort
+ end function
+
+ function g1a(a) result(res)
+ type(f) :: res, a
+ if (res%f .ne. -1 ) call abort
+ end function
+ end program test
