Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/derived_init_4.f90 @ 145:1830386684a0
gcc-9.2.0
author | anatofuz |
---|---|
date | Thu, 13 Feb 2020 11:34:05 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line source
! { 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) STOP 1 ans = g1(a) if (ans%f .ne. -1) STOP 2 ans = g1a(a) if (ans%f .ne. -1) STOP 3 ans = g1a(a) if (ans%f .ne. -1) STOP 4 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 STOP 5 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 STOP 6 endif enddo end function g2 function g1(a) type(f) :: g1, a if (g1%f .ne. -1 ) STOP 7 end function function g1a(a) result(res) type(f) :: res, a if (res%f .ne. -1 ) STOP 8 end function end program test