From: Paul Thomas <pault@gcc.gnu.org>
Date: Fri, 13 Oct 2017 18:59:34 +0000 (+0000)
Subject: re PR fortran/81048 (incorrect derived type initialization)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e6110fa622ff495f5a8d492fcad4cdab5259de0f;p=gcc.git

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 a37d16e51fa..ba9621fc8d5 100644
--- 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 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  <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
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  <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
+