gcc/testsuite/gfortran.dg/derived_init_4.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR81048, where in the second call to 'g2' the
   4 ! default initialization was "forgotten". 'g1', 'g1a' and 'g3' check
   5 ! that this does not occur for scalars and explicit results.
   6 !
   7 ! Contributed by David Smith  <dm577216smith@gmail.com>
   8 !
   9 program test
  10    type f
  11        integer :: f = -1
  12    end type
  13    type(f) :: a, b(3)
  14    type(f), allocatable :: ans
  15    b = g2(a)
  16    b = g2(a)
  17    ans = g1(a)
  18    if (ans%f .ne. -1) STOP 1
  19    ans = g1(a)
  20    if (ans%f .ne. -1) STOP 2
  21    ans = g1a(a)
  22    if (ans%f .ne. -1) STOP 3
  23    ans = g1a(a)
  24    if (ans%f .ne. -1) STOP 4
  25    b = g3(a)
  26    b = g3(a)
  27 contains
  28    function g3(a) result(res)
  29       type(f) :: a, res(3)
  30       do j = 1, 3
  31          if (res(j)%f == -1) then
  32              res(j)%f = a%f - 1
  33          else
  34              STOP 5
  35          endif
  36       enddo
  37    end function g3
  38
  39    function g2(a)
  40       type(f) :: a, g2(3)
  41       do j = 1, 3
  42          if (g2(j)%f == -1) then
  43              g2(j)%f = a%f - 1
  44          else
  45              STOP 6
  46          endif
  47       enddo
  48    end function g2
  49
  50    function g1(a)
  51      type(f) :: g1, a
  52      if (g1%f .ne. -1 ) STOP 7
  53    end function
  54
  55    function g1a(a) result(res)
  56      type(f) :: res, a
  57      if (res%f .ne. -1 ) STOP 8
  58    end function
  59 end program test
  60