OSDN Git Service

PR testsuite/51875
[pf3gnuchains/gcc-fork.git] / 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)) call abort
22
23   allocate(x(4), source=z)
24   if (any(x /= 99.)) call abort
25
26   allocate(t, source=mytype(1.0,2))
27   if (t%r /= 1. .or. t%i /= 2) call abort
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) call abort
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) call abort
42 end subroutine sub1