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 <pa...@gcc.gnu.org> PR fortran/81048 * resolve.c (resolve_symbol): Ensure that derived type array results get default initialization. 2017-10-13 Paul Thomas <pa...@gcc.gnu.org> 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 <dm577216sm...@gmail.com> + ! + 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