|
111
|
1 ! { dg-do run }
|
|
|
2 ! { dg-options "-fcoarray=single" }
|
|
|
3 !
|
|
|
4 ! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran@t-online.de>
|
|
|
5 ! Andre Vehreschild <vehre@gcc.gnu.org>
|
|
|
6 ! Check that PR fortran/69451 is fixed.
|
|
|
7
|
|
|
8 program main
|
|
|
9
|
|
|
10 implicit none
|
|
|
11
|
|
|
12 type foo
|
|
|
13 end type
|
|
|
14
|
|
|
15 class(foo), allocatable :: p[:]
|
|
|
16 class(foo), pointer :: r
|
|
|
17 class(*), allocatable, target :: z
|
|
|
18
|
|
|
19 allocate(p[*])
|
|
|
20
|
|
|
21 call s(p, z)
|
|
|
22 select type (z)
|
|
|
23 class is (foo)
|
|
|
24 r => z
|
|
|
25 class default
|
|
131
|
26 STOP 1
|
|
111
|
27 end select
|
|
|
28
|
|
131
|
29 if (.not. associated(r)) STOP 2
|
|
111
|
30
|
|
|
31 deallocate(r)
|
|
|
32 deallocate(p)
|
|
|
33
|
|
|
34 contains
|
|
|
35
|
|
|
36 subroutine s(x, z)
|
|
|
37 class(*) :: x[*]
|
|
|
38 class(*), allocatable:: z
|
|
|
39 allocate (z, source=x)
|
|
|
40 end
|
|
|
41
|
|
|
42 end
|
|
|
43
|
