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