From: Paul Thomas <pault@gcc.gnu.org>
Date: Thu, 19 Oct 2017 12:16:41 +0000 (+0000)
Subject: re PR fortran/81048 (incorrect derived type initialization)
X-Git-Tag: releases/gcc-6.5.0~730
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=8360d12c08a583dbc8dfb827fbc5fb1614963116;p=thirdparty%2Fgcc.git

re PR fortran/81048 (incorrect derived type initialization)

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

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

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

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

From-SVN: r253889
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ac16bc09fc12..49177ba05ed2 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2017-10-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	Backport from trunk
+	PR fortran/81048
+	* resolve.c (resolve_symbol): Ensure that derived type array
+	results get default initialization.
+
 2017-10-06  Thomas Koenig <tkoenig@gcc.gnu.org>
 	    Steven G. Kargl <kargl@gcc.gnu.org>
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7cf2ca24725c..e068f78268a1 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -14493,7 +14493,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 890a6cd675bd..1a6f0bda88c6 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2017-10-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	Backport from trunk
+	PR fortran/81048
+	* gfortran.dg/derived_init_4.f90 : New test.
+
 2017-10-17  Jakub Jelinek  <jakub@redhat.com>
 
 	PR tree-optimization/82549
@@ -10,11 +16,11 @@
 	* gcc.dg/pr82274-2.c: New test.
 
 2017-10-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
-            Steven G. Kargl  <kargl@gcc.gnu.org>
+	    Steven G. Kargl  <kargl@gcc.gnu.org>
 
-        Backport from trunk
-        PR fortran/80118
-        * gfortran.dg/zero_sized_7.f90: New test.
+	Backport from trunk
+	PR fortran/80118
+	* gfortran.dg/zero_sized_7.f90: New test.
 
 2017-10-02  Bill Schmidt  <wschmidt@linux.vnet.ibm.com>
 
@@ -38,7 +44,7 @@
 	* g++.dg/other/pr81355.C: New test.
 
 2017-09-18  Richard Biener  <rguenther@suse.de>
- 
+
 	Backport from mainline
 	2017-04-07  Richard Biener  <rguenther@suse.de>
 
@@ -51,7 +57,7 @@
 	* gcc.dg/torture/pr80281.c: New testcase.
 
 2017-09-18  Richard Biener  <rguenther@suse.de>
- 
+
 	Backport from mainline
 	2017-08-28  Richard Biener  <rguenther@suse.de>
 
@@ -920,7 +926,7 @@
 	2017-02-21  Jakub Jelinek  <jakub@redhat.com>
 
 	PR c++/79639
-	* g++.dg/cpp1y/constexpr-79639.C: New test. 
+	* g++.dg/cpp1y/constexpr-79639.C: New test.
 
 	PR target/79570
 	* gcc.dg/pr79570.c: New test.
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 000000000000..5f3c7882ff21
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_init_4.f90
@@ -0,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  <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