|
111
|
1 ! { dg-do run }
|
|
|
2 !
|
|
|
3 ! Tests the fix for PR67933, which was a side effect of the fix for PR67171.
|
|
|
4 !
|
|
|
5 ! Contributed by Andrew <mandrew9@vt.edu>
|
|
|
6 !
|
|
|
7 module test_mod
|
|
|
8 implicit none
|
|
|
9
|
|
|
10 type :: class_t
|
|
|
11 integer :: i
|
|
|
12 end type class_t
|
|
|
13
|
|
|
14 type, extends(class_t) :: class_e
|
|
|
15 real :: r
|
|
|
16 end type class_e
|
|
|
17
|
|
|
18 type :: wrapper_t
|
|
|
19 class(class_t), allocatable :: class_var
|
|
|
20 ! type(class_t), allocatable :: class_var
|
|
|
21 ! integer, allocatable :: class_id
|
|
|
22 end type wrapper_t
|
|
|
23
|
|
|
24 type :: list_t
|
|
|
25 type(wrapper_t) :: classes(20)
|
|
|
26 contains
|
|
|
27 procedure :: Method
|
|
|
28 procedure :: Typeme
|
|
|
29 procedure :: Dealloc
|
|
|
30 end type list_t
|
|
|
31
|
|
|
32 contains
|
|
|
33 subroutine Method(this)
|
|
|
34 class(list_t) :: this
|
|
|
35 integer :: i
|
|
|
36 do i = 1, 20
|
|
|
37 if (i .gt. 10) then
|
|
|
38 allocate (this%classes(i)%class_var, source = class_t (i))
|
|
|
39 else
|
|
|
40 allocate (this%classes(i)%class_var, source = class_e (i, real (2 * i)))
|
|
|
41 end if
|
|
|
42 end do
|
|
|
43 end subroutine Method
|
|
|
44 subroutine Dealloc(this)
|
|
|
45 class(list_t) :: this
|
|
|
46 integer :: i
|
|
|
47 do i = 1, 20
|
|
|
48 if (allocated (this%classes(i)%class_var)) &
|
|
|
49 deallocate (this%classes(i)%class_var)
|
|
|
50 end do
|
|
|
51 end subroutine Dealloc
|
|
|
52 subroutine Typeme(this)
|
|
|
53 class(list_t) :: this
|
|
|
54 integer :: i, j(20)
|
|
|
55 real :: r(20)
|
|
|
56 real :: zero = 0.0
|
|
|
57 do i = 1, 20
|
|
|
58 j(i) = this%classes(i)%class_var%i
|
|
|
59 select type (p => this%classes(i)%class_var)
|
|
|
60 type is (class_e)
|
|
|
61 r(i) = p%r
|
|
|
62 class default
|
|
|
63 r(i) = zero
|
|
|
64 end select
|
|
|
65 end do
|
|
|
66 ! print "(10i6,/)", j
|
|
131
|
67 if (any (j .ne. [(i, i = 1,20)])) STOP 1
|
|
111
|
68 ! print "(10f6.2,/)", r
|
|
131
|
69 if (any (r(1:10) .ne. [(real (2 * i), i = 1,10)])) STOP 2
|
|
|
70 if (any (r(11:20) .ne. zero)) STOP 3
|
|
111
|
71 end subroutine Typeme
|
|
|
72 end module test_mod
|
|
|
73
|
|
|
74 use test_mod
|
|
|
75 type(list_t) :: x
|
|
|
76 call x%Method
|
|
|
77 call x%Typeme
|
|
|
78 call x%dealloc
|
|
|
79 end
|
