aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/coarray_allocate_4.f08
blob: a36d7968b420e45e705cdc5ab7489171f5db65bb (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
43
! { dg-do run }
! { dg-options "-fcoarray=single" }
!
! Contributed by Gerhard Steinmetz  <gerhard.steinmetz.fortran@t-online.de>
!               Andre Vehreschild <vehre@gcc.gnu.org>
! Check that PR fortran/69451 is fixed.

program main

implicit none

type foo
end type

class(foo), allocatable :: p[:]
class(foo), pointer :: r
class(*), allocatable, target :: z

allocate(p[*])

call s(p, z)
select type (z)
  class is (foo) 
        r => z
  class default
     call abort()
end select

if (.not. associated(r)) call abort()

deallocate(r)
deallocate(p)

contains

subroutine s(x, z) 
   class(*) :: x[*]
   class(*), allocatable:: z
   allocate (z, source=x)
end

end