1! { dg-do run }
2!
3! Checks the fix for PR67171, where the second ALLOCATE with and array section
4! SOURCE produced a zero index based temporary, which threw the assignment.
5!
6! Contributed by Anton Shterenlikht  <mexas@bristol.ac.uk>
7!
8program z
9  implicit none
10  integer, parameter :: DIM1_SIZE = 10
11  real, allocatable :: d(:,:), tmp(:,:)
12  integer :: i, errstat
13
14  allocate (d(DIM1_SIZE, 2), source = 0.0, stat=errstat )
15
16  d(:,1) = [( real (i), i=1,DIM1_SIZE)]
17  d(:,2) = [( real(2*i), i=1,DIM1_SIZE)]
18!  write (*,*) d(1, :)
19
20  call move_alloc (from = d, to = tmp)
21!  write (*,*) tmp( 1, :)
22
23  allocate (d(DIM1_SIZE / 2, 2), source = tmp(1 : DIM1_SIZE / 2, :) , stat=errstat)
24  if (any (d .ne. tmp(1:DIM1_SIZE/2,:))) call abort
25  deallocate (d)
26
27  allocate (d(DIM1_SIZE / 2, 2), source = foo (tmp(1 : DIM1_SIZE / 2, :)) , stat=errstat)
28  if (any (d .ne. tmp(1 : DIM1_SIZE / 2, :))) call abort
29
30  deallocate (tmp , d)
31
32contains
33  function foo (arg) result (res)
34    real :: arg(:,:)
35    real :: res(size (arg, 1), size (arg, 2))
36    res = arg
37  end function
38end program z
39