Imported Upstream version 4.8.1
[platform/upstream/gcc48.git] / gcc / testsuite / gfortran.dg / unlimited_polymorphic_5.f90
1 ! { dg-do run }
2 !
3 ! PR fortran/55763
4 !
5 ! Based on Reinhold Bader's test case
6 !
7
8 program mvall_03
9   implicit none
10   integer, parameter :: n1 = 100, n2 = 200
11   class(*), allocatable :: i1(:), i3(:)
12   integer, allocatable :: i2(:)
13
14   allocate(real :: i1(n1))
15   allocate(i2(n2))
16   i2 = 2
17   call move_alloc(i2, i1)
18   if (size(i1) /= n2 .or. allocated(i2)) then
19     call abort
20 !   write(*,*) 'FAIL'
21   else
22 !    write(*,*) 'OK'
23   end if
24
25   select type (i1)
26     type is (integer)
27       if (any (i1 /= 2)) call abort
28     class default
29       call abort()
30   end select
31   call move_alloc (i1, i3)
32   if (size(i3) /= n2 .or. allocated(i1)) then
33     call abort()
34   end if
35   select type (i3)
36     type is (integer)
37       if (any (i3 /= 2)) call abort
38     class default
39       call abort()
40   end select
41 end program