re PR fortran/81048 (incorrect derived type initialization)

2017-10-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/81048
	* resolve.c (resolve_symbol): Ensure that derived type array
	results get default initialization.

2017-10-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/81048
	* gfortran.dg/derived_init_4.f90 : New test.

From-SVN: r253738

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a37d16e51fa705e09ed42b4464e17622c5f3e618..ba9621fc8d5aa4464da67dfdac0105c5741e3890 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2017-10-13  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/81048
+       * resolve.c (resolve_symbol): Ensure that derived type array
+       results get default initialization.
+
 2017-10-11  Nathan Sidwell  <nathan@acm.org>
 
        * cpp.c (gfc_cpp_add_include_path): Update incpath_e names.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index bd316344813c6fd783c6ac30e5f0847fca5b114b..5e4988e694510b6c3261e7cafa3efeb15d908194 100644 (file)
--- 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 589dda59fc6e21f7d1113ae28c5f701a70fe0665..1a6ad0d7660475a1b8e1e55569009bf77a0dd77b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-10-13  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/81048
+       * gfortran.dg/derived_init_4.f90 : New test.
+
 2017-10-13  Paolo Carlini  <paolo.carlini@oracle.com>
 
        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 (file)
index 0000000..1149751
--- /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  <dm577216smith@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
+