gcc/testsuite/gfortran.dg/alloc_comp_default_init_1.f90

   1 ! { dg-do run }
   2 ! Checks the fixes for PR34681 and PR34704, in which various mixtures
   3 ! of default initializer and allocatable array were not being handled
   4 ! correctly for derived types with allocatable components.
   5 !
   6 ! Contributed by Paolo Giannozzi <p.giannozzi@fisica.uniud.it>
   7 !
   8 program boh
   9   integer :: c1, c2, c3, c4, c5
  10   !
  11   call mah (0, c1) ! These calls deal with PR34681
  12   call mah (1, c2)
  13   call mah (2, c3)
  14   !
  15   if (c1 /= c2) STOP 1
  16   if (c1 /= c3) STOP 1
  17   !
  18   call mah0 (c4) ! These calls deal with PR34704
  19   call mah1 (c5)
  20   !
  21   if (c4 /= c5) STOP 2
  22   !
  23 end program boh
  24 !
  25 subroutine mah (i, c)
  26   !
  27   integer, intent(in) :: i
  28   integer, intent(OUT) :: c
  29   !
  30   type mix_type
  31      real(8), allocatable :: a(:)
  32      complex(8), allocatable :: b(:)
  33   end type mix_type
  34   type(mix_type), allocatable, save :: t(:)
  35   integer :: j, n=1024
  36   !
  37   if (i==0) then
  38      allocate (t(1))
  39      allocate (t(1)%a(n))
  40      allocate (t(1)%b(n))
  41      do j=1,n
  42         t(1)%a(j) = j
  43         t(1)%b(j) = n-j
  44      end do
  45   end if
  46   c = sum( t(1)%a(:) ) + sum( t(1)%b(:) )
  47   if ( i==2) then
  48      deallocate (t(1)%b)
  49      deallocate (t(1)%a)
  50      deallocate (t)
  51   end if
  52 end subroutine mah
  53
  54 subroutine mah0 (c)
  55   !
  56   integer, intent(OUT) :: c
  57   type mix_type
  58      real(8), allocatable :: a(:)
  59      integer :: n=1023
  60   end type mix_type
  61   type(mix_type) :: t
  62   !
  63   allocate(t%a(1))
  64   t%a=3.1415926
  65   c = t%n
  66   deallocate(t%a)
  67   !
  68 end subroutine mah0
  69 !
  70 subroutine mah1 (c)
  71   !
  72   integer, intent(OUT) :: c
  73   type mix_type
  74      real(8), allocatable :: a(:)
  75      integer :: n=1023
  76   end type mix_type
  77   type(mix_type), save :: t
  78   !
  79   allocate(t%a(1))
  80   t%a=3.1415926
  81   c = t%n
  82   deallocate(t%a)
  83   !
  84 end subroutine mah1