gcc/testsuite/gfortran.dg/allocate_with_source_12.f03

   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 !
   8 program 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,:))) STOP 1
  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, :))) STOP 2
  29
  30   deallocate (tmp , d)
  31
  32 contains
  33   function foo (arg) result (res)
  34     real :: arg(:,:)
  35     real :: res(size (arg, 1), size (arg, 2))
  36     res = arg
  37   end function
  38 end program z