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
77
78
79
|
! { dg-do run }
!
! Tests the fix for PR67933, which was a side effect of the fix for PR67171.
!
! Contributed by Andrew <mandrew9@vt.edu>
!
module test_mod
implicit none
type :: class_t
integer :: i
end type class_t
type, extends(class_t) :: class_e
real :: r
end type class_e
type :: wrapper_t
class(class_t), allocatable :: class_var
! type(class_t), allocatable :: class_var
! integer, allocatable :: class_id
end type wrapper_t
type :: list_t
type(wrapper_t) :: classes(20)
contains
procedure :: Method
procedure :: Typeme
procedure :: Dealloc
end type list_t
contains
subroutine Method(this)
class(list_t) :: this
integer :: i
do i = 1, 20
if (i .gt. 10) then
allocate (this%classes(i)%class_var, source = class_t (i))
else
allocate (this%classes(i)%class_var, source = class_e (i, real (2 * i)))
end if
end do
end subroutine Method
subroutine Dealloc(this)
class(list_t) :: this
integer :: i
do i = 1, 20
if (allocated (this%classes(i)%class_var)) &
deallocate (this%classes(i)%class_var)
end do
end subroutine Dealloc
subroutine Typeme(this)
class(list_t) :: this
integer :: i, j(20)
real :: r(20)
real :: zero = 0.0
do i = 1, 20
j(i) = this%classes(i)%class_var%i
select type (p => this%classes(i)%class_var)
type is (class_e)
r(i) = p%r
class default
r(i) = zero
end select
end do
! print "(10i6,/)", j
if (any (j .ne. [(i, i = 1,20)])) call abort
! print "(10f6.2,/)", r
if (any (r(1:10) .ne. [(real (2 * i), i = 1,10)])) call abort
if (any (r(11:20) .ne. zero)) call abort
end subroutine Typeme
end module test_mod
use test_mod
type(list_t) :: x
call x%Method
call x%Typeme
call x%dealloc
end
|
