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!
6module 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
15contains
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
29end module foo
30
31program 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
42end program main2
43