1! { dg-do run }
2! Test the move_alloc intrinsic.
3!
4! Contributed by Erik Edelmann  <eedelmann@gcc.gnu.org>
5!            and Paul Thomas  <pault@gcc.gnu.org>
6!
7program test_move_alloc
8
9    implicit none
10    integer, allocatable :: x(:), y(:), temp(:)
11    character(4), allocatable :: a(:), b(:)
12    integer :: i
13
14    allocate (x(2))
15    allocate (a(2))
16
17    x = [ 42, 77 ]
18
19    call move_alloc (x, y)
20    if (allocated(x)) call abort()
21    if (.not.allocated(y)) call abort()
22    if (any(y /= [ 42, 77 ])) call abort()
23
24    a = [ "abcd", "efgh" ]
25    call move_alloc (a, b)
26    if (allocated(a)) call abort()
27    if (.not.allocated(b)) call abort()
28    if (any(b /= [ "abcd", "efgh" ])) call abort()
29
30    ! Now one of the intended applications of move_alloc; resizing
31
32    call move_alloc (y, temp)
33    allocate (y(6), stat=i)
34    if (i /= 0) call abort()
35    y(1:2) = temp
36    y(3:) = 99
37    deallocate(temp)
38    if (any(y /= [ 42, 77, 99, 99, 99, 99 ])) call abort()
39end program test_move_alloc
40