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

program main2
  use foo
  implicit none
  type(foo_t) :: o
  real, allocatable :: u(:)
  u=real ([3,2,1,4])
  call o%make(u)
  if (any (int (o%disp()) .ne. [1,2,3,4])) call abort
  u=real ([2,1])
  call o%make(u)
  if (any (int (o%disp()) .ne. [1,2])) call abort
end program main2