OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/81048 (incorrect derived type initialization) 

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

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

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

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

From-SVN: r253793
This commit is contained in:
Paul Thomas 2017-10-16 18:48:56 +00:00
parent 0e5c063608
commit ac7b259d92
4 changed files with 81 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2017-10-16 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-03 Thomas Koenig <tkoenig@gcc.gnu.org>
Steven G. Kargl <kargl@gcc.gnu.org>

7
gcc/fortran/resolve.c
View File

@ -14793,7 +14793,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

12
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2017-10-16 Paul Thomas <pault@gcc.gnu.org>
Backport from trunk
PR fortran/81048
* gfortran.dg/derived_init_4.f90 : New test.
2017-10-13 Jakub Jelinek <jakub@redhat.com>
PR target/82274
@ -126,7 +132,7 @@
Backported from mainline
2017-09-14 Jakub Jelinek <jakub@redhat.com>
PR target/81325
* g++.dg/cpp0x/pr81325.C: New test.
@ -615,7 +621,7 @@
* gfortran.dg/pr81175.f: New testcase.
2017-06-21 Marc Glisse <marc.glisse@inria.fr>
* gcc.dg/tree-ssa/addadd.c: Un-XFAIL.
* gcc.dg/tree-ssa/addadd-2.c: New file.
@ -823,7 +829,7 @@
* c-c++-common/ubsan/sanitize-recover-7.c (dg-options): Add -w.
2017-06-24 Marek Polacek <polacek@redhat.com>
Backport from mainline
2017-05-04 Marek Polacek <polacek@redhat.com>

59
gcc/testsuite/gfortran.dg/derived_init_4.f90 Normal file
View File

@ -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