From e6110fa622ff495f5a8d492fcad4cdab5259de0f Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Fri, 13 Oct 2017 18:59:34 +0000 Subject: [PATCH] re PR fortran/81048 (incorrect derived type initialization) 2017-10-13 Paul Thomas PR fortran/81048 * resolve.c (resolve_symbol): Ensure that derived type array results get default initialization. 2017-10-13 Paul Thomas PR fortran/81048 * gfortran.dg/derived_init_4.f90 : New test. From-SVN: r253738 --- gcc/fortran/ChangeLog | 6 ++ gcc/fortran/resolve.c | 7 ++- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/derived_init_4.f90 | 60 ++++++++++++++++++++ 4 files changed, 77 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/derived_init_4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a37d16e51fa..ba9621fc8d5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2017-10-13 Paul Thomas + + PR fortran/81048 + * resolve.c (resolve_symbol): Ensure that derived type array + results get default initialization. + 2017-10-11 Nathan Sidwell * cpp.c (gfc_cpp_add_include_path): Update incpath_e names. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index bd316344813..5e4988e6945 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -14967,7 +14967,12 @@ resolve_symbol (gfc_symbol *sym) if ((!a->save && !a->dummy && !a->pointer && !a->in_common && !a->use_assoc - && !a->result && !a->function) + && 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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 589dda59fc6..1a6ad0d7660 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-10-13 Paul Thomas + + PR fortran/81048 + * gfortran.dg/derived_init_4.f90 : New test. + 2017-10-13 Paolo Carlini PR c++/69078 diff --git a/gcc/testsuite/gfortran.dg/derived_init_4.f90 b/gcc/testsuite/gfortran.dg/derived_init_4.f90 new file mode 100644 index 00000000000..114975150aa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/derived_init_4.f90 @@ -0,0 +1,60 @@ +! { 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 +! +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 + -- 2.30.2