gcc/testsuite/gfortran.dg/allocate_alloc_opt_6.f90

   1 ! { dg-do run }
   2 program a
   3
   4   implicit none
   5
   6   type :: mytype
   7     real ::  r
   8     integer :: i
   9   end type mytype
  10
  11   integer n
  12   integer, allocatable :: i(:)
  13   real z
  14   real, allocatable :: x(:)
  15   type(mytype), pointer :: t
  16
  17   n = 42
  18   z = 99.
  19
  20   allocate(i(4), source=n)
  21   if (any(i /= 42)) STOP 1
  22
  23   allocate(x(4), source=z)
  24   if (any(x /= 99.)) STOP 2
  25
  26   allocate(t, source=mytype(1.0,2))
  27   if (t%r /= 1. .or. t%i /= 2) STOP 3
  28
  29   deallocate(i)
  30   allocate(i(3), source=(/1, 2, 3/))
  31   if (i(1) /= 1 .or. i(2) /= 2 .or. i(3) /= 3) STOP 4
  32
  33   call sub1(i)
  34
  35 end program a
  36
  37 subroutine sub1(j)
  38    integer, intent(in) :: j(*)
  39    integer, allocatable :: k(:)
  40    allocate(k(2), source=j(1:2))
  41    if (k(1) /= 1 .or. k(2) /= 2) STOP 5
  42 end subroutine sub1