gcc/testsuite/gfortran.dg/alloc_comp_assign_12.f03

   1 ! { dg-do run }
   2 ! PR48351 - automatic (re)allocation of allocatable components of class objects
   3 !
   4 ! Contributed by Nasser M. Abbasi on comp.lang.fortran
   5 !
   6 module foo
   7   implicit none
   8   type :: foo_t
   9     private
  10     real, allocatable :: u(:)
  11   contains
  12     procedure :: make
  13     procedure :: disp
  14   end type foo_t
  15 contains
  16   subroutine make(this,u)
  17     implicit none
  18     class(foo_t) :: this
  19     real, intent(in) :: u(:)
  20     this%u = u(int (u))       ! The failure to allocate occurred here.
  21     if (.not.allocated (this%u)) STOP 1
  22   end subroutine make
  23   function disp(this)
  24     implicit none
  25     class(foo_t) :: this
  26     real, allocatable :: disp (:)
  27     if (allocated (this%u)) disp = this%u
  28   end function
  29 end module foo
  30
  31 program main2
  32   use foo
  33   implicit none
  34   type(foo_t) :: o
  35   real, allocatable :: u(:)
  36   u=real ([3,2,1,4])
  37   call o%make(u)
  38   if (any (int (o%disp()) .ne. [1,2,3,4])) STOP 2
  39   u=real ([2,1])
  40   call o%make(u)
  41   if (any (int (o%disp()) .ne. [1,2])) STOP 3
  42 end program main2