|
111
|
1 ! { dg-do run }
|
|
|
2 !
|
|
|
3 ! PR 41829: [OOP] Runtime error with dynamic dispatching. Tests
|
|
|
4 ! dynamic dispatch in a case where the caller knows nothing about
|
|
|
5 ! the dynamic type at compile time.
|
|
|
6 !
|
|
|
7 ! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
|
|
|
8 !
|
|
|
9 module foo_mod
|
|
|
10 type foo
|
|
|
11 integer :: i
|
|
|
12 contains
|
|
|
13 procedure, pass(a) :: doit
|
|
|
14 procedure, pass(a) :: getit
|
|
|
15 end type foo
|
|
|
16
|
|
|
17 private doit,getit
|
|
|
18 contains
|
|
|
19 subroutine doit(a)
|
|
|
20 class(foo) :: a
|
|
|
21
|
|
|
22 a%i = 1
|
|
|
23 ! write(*,*) 'FOO%DOIT base version'
|
|
|
24 end subroutine doit
|
|
|
25 function getit(a) result(res)
|
|
|
26 class(foo) :: a
|
|
|
27 integer :: res
|
|
|
28
|
|
|
29 res = a%i
|
|
|
30 end function getit
|
|
|
31
|
|
|
32 end module foo_mod
|
|
|
33 module foo2_mod
|
|
|
34 use foo_mod
|
|
|
35
|
|
|
36 type, extends(foo) :: foo2
|
|
|
37 integer :: j
|
|
|
38 contains
|
|
|
39 procedure, pass(a) :: doit => doit2
|
|
|
40 procedure, pass(a) :: getit => getit2
|
|
|
41 end type foo2
|
|
|
42
|
|
|
43 private doit2, getit2
|
|
|
44
|
|
|
45 contains
|
|
|
46
|
|
|
47 subroutine doit2(a)
|
|
|
48 class(foo2) :: a
|
|
|
49
|
|
|
50 a%i = 2
|
|
|
51 a%j = 3
|
|
|
52 ! write(*,*) 'FOO2%DOIT derived version'
|
|
|
53 end subroutine doit2
|
|
|
54 function getit2(a) result(res)
|
|
|
55 class(foo2) :: a
|
|
|
56 integer :: res
|
|
|
57
|
|
|
58 res = a%j
|
|
|
59 end function getit2
|
|
|
60
|
|
|
61 end module foo2_mod
|
|
|
62
|
|
|
63 module bar_mod
|
|
|
64 use foo_mod
|
|
|
65 type bar
|
|
|
66 class(foo), allocatable :: a
|
|
|
67 contains
|
|
|
68 procedure, pass(a) :: doit
|
|
|
69 procedure, pass(a) :: getit
|
|
|
70 end type bar
|
|
|
71 private doit,getit
|
|
|
72
|
|
|
73 contains
|
|
|
74 subroutine doit(a)
|
|
|
75 class(bar) :: a
|
|
|
76
|
|
|
77 call a%a%doit()
|
|
|
78 end subroutine doit
|
|
|
79 function getit(a) result(res)
|
|
|
80 class(bar) :: a
|
|
|
81 integer :: res
|
|
|
82
|
|
|
83 res = a%a%getit()
|
|
|
84 end function getit
|
|
|
85 end module bar_mod
|
|
|
86
|
|
|
87
|
|
|
88 program testd10
|
|
|
89 use foo_mod
|
|
|
90 use foo2_mod
|
|
|
91 use bar_mod
|
|
|
92
|
|
|
93 type(bar) :: a
|
|
|
94
|
|
|
95 allocate(foo :: a%a)
|
|
|
96 call a%doit()
|
|
|
97 ! write(*,*) 'Getit value : ', a%getit()
|
|
131
|
98 if (a%getit() .ne. 1) STOP 1
|
|
111
|
99 deallocate(a%a)
|
|
|
100 allocate(foo2 :: a%a)
|
|
|
101 call a%doit()
|
|
|
102 ! write(*,*) 'Getit value : ', a%getit()
|
|
131
|
103 if (a%getit() .ne. 3) STOP 2
|
|
111
|
104
|
|
|
105 end program testd10
|
