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 ac16bc09fc121742d7dd57d467c4c6f270b03405..49177ba05ed2651d9f08a4d15f43392df660b255 100644 (file)
--- 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 7cf2ca24725cd5f29894261441e6efdf09a880e9..e068f78268a15e9f1c9fc37b3045f53014ad3ec1 100644 (file)
--- 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 890a6cd675bdb9abfdb9651817d944be65a52130..1a6f0bda88c6992d285f16088120c04ec7f10b07 100644 (file)
--- 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 (file)
index 0000000..5f3c788
--- /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