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:
parent
0e5c063608
commit
ac7b259d92
|
@ -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>
|
2017-10-03 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||||
Steven G. Kargl <kargl@gcc.gnu.org>
|
Steven G. Kargl <kargl@gcc.gnu.org>
|
||||||
|
|
||||||
|
|
|
@ -14793,7 +14793,12 @@ resolve_symbol (gfc_symbol *sym)
|
||||||
|
|
||||||
if ((!a->save && !a->dummy && !a->pointer
|
if ((!a->save && !a->dummy && !a->pointer
|
||||||
&& !a->in_common && !a->use_assoc
|
&& !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))
|
|| (a->dummy && a->intent == INTENT_OUT && !a->pointer))
|
||||||
apply_default_init (sym);
|
apply_default_init (sym);
|
||||||
else if (a->function && sym->result && a->access != ACCESS_PRIVATE
|
else if (a->function && sym->result && a->access != ACCESS_PRIVATE
|
||||||
|
|
|
@ -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>
|
2017-10-13 Jakub Jelinek <jakub@redhat.com>
|
||||||
|
|
||||||
PR target/82274
|
PR target/82274
|
||||||
|
|
|
@ -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
|
Loading…
Reference in New Issue