gcc/testsuite/gfortran.dg/allocate_with_source_26.f90

   1 ! { dg-do run }
   2 !
   3 ! Ensure that the lower bound starts with the correct
   4 ! value
   5 !
   6 ! PR fortran/87580
   7 ! PR fortran/67125
   8 !
   9 ! Contributed by Antony Lewis and mrestelli
  10 !
  11 program p
  12  implicit none
  13  integer, allocatable :: a(:), b(:), c(:), d(:), e(:)
  14  type t
  15    integer :: i
  16  end type t
  17  class(t), allocatable :: p1(:), p2(:), p3(:), p4(:)
  18  integer :: vec(6)
  19
  20  vec = [1,2,3,4,5,6]
  21
  22  allocate(a, source=f(3))
  23  allocate(b, source=g(3))
  24  allocate(c, source=h(3))
  25  allocate(d, source=[1,2,3,4,5])
  26  allocate(e, source=vec)
  27
  28  allocate(p1(3:4))
  29  p1(:)%i = [43,56]
  30  allocate(p2, source=p1)
  31  call do_allocate(p1, size(p1))
  32  allocate(p4, source=poly_init())
  33
  34  if (lbound(p1, 1) /= 3 .or. ubound(p1, 1) /= 4 &
  35      .or. lbound(p2, 1) /= 3 .or. ubound(p2, 1) /= 4 &
  36      .or. lbound(p3, 1) /= 1 .or. ubound(p3, 1) /= 2 &
  37      .or. lbound(p4, 1) /= 1 .or. ubound(p4, 1) /= 2 &
  38      .or. p1(3)%i /= 43 .or. p1(4)%i /= 56 &
  39      .or. p2(3)%i /= 43 .or. p2(4)%i /= 56 &
  40      .or. p3(1)%i /= 43 .or. p3(2)%i /= 56 &
  41      .or. p4(1)%i /= 11 .or. p4(2)%i /= 12) then
  42    call abort()
  43  endif
  44
  45  !write(*,*) lbound(a,1), ubound(a,1) ! prints 1 3
  46  !write(*,*) lbound(b,1), ubound(b,1) ! prints 1 3
  47  !write(*,*) lbound(c,1), ubound(c,1) ! prints 1 3
  48  !write(*,*) lbound(d,1), ubound(d,1) ! prints 1 5
  49  !write(*,*) lbound(e,1), ubound(e,1) ! prints 1 6
  50
  51  if (lbound(a,1) /= 1 .or. ubound(a,1) /= 3 &
  52      .or. lbound(b,1) /= 1 .or. ubound(b,1) /= 3 &
  53      .or. lbound(c,1) /= 1 .or. ubound(c,1) /= 3 &
  54      .or. lbound(d,1) /= 1 .or. ubound(d,1) /= 5 &
  55      .or. lbound(e,1) /= 1 .or. ubound(e,1) /= 6) then
  56    call abort()
  57  endif
  58
  59 contains
  60
  61  subroutine do_allocate(x, n)
  62    integer, value :: n
  63    class(t), intent(in) :: x(n)
  64    allocate(p3, source=x)
  65  end subroutine
  66
  67  function poly_init()
  68    class(t), allocatable :: poly_init(:)
  69    allocate(poly_init(7:8))
  70    poly_init = [t :: t(11), t(12)]
  71  end function poly_init
  72
  73  pure function f(i)
  74   integer, intent(in) :: i
  75   integer :: f(i)
  76    f = 2*i
  77  end function f
  78
  79  pure function g(i) result(r)
  80   integer, value, intent(in) :: i
  81   integer, allocatable :: r(:)
  82   r = [1,2,3]
  83  end function g
  84
  85  pure function h(i) result(r)
  86   integer, value, intent(in) :: i
  87   integer, allocatable :: r(:)
  88   allocate(r(3:5))
  89   r = [1,2,3]
  90  end function h
  91 end program p