gcc/testsuite/gfortran.dg/alloc_comp_bounds_1.f90

   1 ! { dg-do run }
   2 ! Test the fix for PR38324, in which the bounds were not set correctly for
   3 ! constructor assignments with allocatable components.
   4 !
   5 ! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
   6 !
   7   integer, parameter :: ik4 = 4
   8   integer, parameter :: ik8 = 8
   9   integer, parameter :: from = -1, to = 2
  10   call foo
  11   call bar
  12 contains
  13   subroutine foo
  14     type :: struct
  15       integer(4), allocatable :: ib(:)
  16     end type struct
  17     integer(ik4), allocatable :: ia(:)
  18     type(struct) :: x
  19     allocate(ia(from:to))
  20     if (any(lbound(ia) .ne. -1) .or. any(ubound(ia) .ne. 2)) call abort
  21     if (any(lbound(ia(:)) .ne. 1) .or. any(ubound(ia(:)) .ne. 4)) call abort
  22     if (any(lbound(ia(from:to)) .ne. 1) .or. any(ubound(ia(from:to)) .ne. 4)) call abort
  23     x=struct(ia)
  24     if (any(lbound(x%ib) .ne. -1) .or. any(ubound(x%ib) .ne. 2)) call abort
  25     x=struct(ia(:))
  26     if (any(lbound(x%ib) .ne. 1) .or. any(ubound(x%ib) .ne. 4)) call abort
  27     x=struct(ia(from:to))
  28     if (any(lbound(x%ib) .ne. 1) .or. any(ubound(x%ib) .ne. 4)) call abort
  29     deallocate(ia)
  30   end subroutine
  31   subroutine bar
  32     type :: struct
  33       integer(4), allocatable :: ib(:)
  34     end type struct
  35     integer(ik8), allocatable :: ia(:)
  36     type(struct) :: x
  37     allocate(ia(from:to))
  38     if (any(lbound(ia) .ne. -1) .or. any(ubound(ia) .ne. 2)) call abort
  39     if (any(lbound(ia(:)) .ne. 1) .or. any(ubound(ia(:)) .ne. 4)) call abort
  40     if (any(lbound(ia(from:to)) .ne. 1) .or. any(ubound(ia(from:to)) .ne. 4)) call abort
  41     x=struct(ia)
  42     if (any(lbound(x%ib) .ne. -1) .or. any(ubound(x%ib) .ne. 2)) call abort
  43     x=struct(ia(:))
  44     if (any(lbound(x%ib) .ne. 1) .or. any(ubound(x%ib) .ne. 4)) call abort
  45     x=struct(ia(from:to))
  46     if (any(lbound(x%ib) .ne. 1) .or. any(ubound(x%ib) .ne. 4)) call abort
  47     deallocate(ia)
  48   end subroutine
  49 end
  50