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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
! { dg-do run }
!
! Test the fix for PR100103
!
program main_p
implicit none
integer :: i
integer, parameter :: n = 11
type :: foo_t
integer :: i
end type foo_t
type(foo_t), parameter :: a(*) = [(foo_t(i), i=1,n)]
type(foo_t), allocatable :: bar_d(:)
class(foo_t), allocatable :: bar_p(:)
class(*), allocatable :: bar_u(:)
call foo_d(bar_d)
if(.not.allocated(bar_d)) stop 1
if(any(bar_d%i/=a%i)) stop 2
deallocate(bar_d)
call foo_p(bar_p)
if(.not.allocated(bar_p)) stop 3
if(any(bar_p%i/=a%i)) stop 4
deallocate(bar_p)
call foo_u(bar_u)
if(.not.allocated(bar_u)) stop 5
select type(bar_u)
type is(foo_t)
if(any(bar_u%i/=a%i)) stop 6
class default
stop 7
end select
deallocate(bar_u)
contains
subroutine foo_d(that)
type(foo_t), allocatable, intent(out) :: that(..)
select rank(that)
rank(1)
that = a
rank default
stop 8
end select
end subroutine foo_d
subroutine foo_p(that)
class(foo_t), allocatable, intent(out) :: that(..)
select rank(that)
rank(1)
that = a
rank default
stop 9
end select
end subroutine foo_p
subroutine foo_u(that)
class(*), allocatable, intent(out) :: that(..)
select rank(that)
rank(1)
that = a
rank default
stop 10
end select
end subroutine foo_u
end program main_p
|
