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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
! { dg-do run }
! { dg-options "-fdump-tree-original" }
!
! PR fortran/54603
!
! Contributed by Kacper Kowalik
!
module foo
implicit none
interface
subroutine cg_ext
implicit none
end subroutine cg_ext
end interface
type :: ext_ptr
procedure(cg_ext), nopass, pointer :: init
procedure(cg_ext), nopass, pointer :: cleanup
end type ext_ptr
type :: ext_ptr_array
type(ext_ptr) :: a
contains
procedure :: epa_init
end type ext_ptr_array
type(ext_ptr_array) :: bar
contains
subroutine epa_init(this, init, cleanup)
implicit none
class(ext_ptr_array), intent(inout) :: this
procedure(cg_ext), pointer, intent(in) :: init
procedure(cg_ext), pointer, intent(in) :: cleanup
this%a = ext_ptr(null(), null()) ! Wrong code
this%a = ext_ptr(init, cleanup) ! Wrong code
this%a%init => init ! OK
this%a%cleanup => cleanup ! OK
this%a = ext_ptr(this%a%init,this%a%cleanup) ! ICE in fold_convert_loc
end subroutine epa_init
end module foo
program ala
use foo, only: bar
implicit none
integer :: count1, count2
count1 = 0
count2 = 0
call setme
call bar%a%cleanup()
call bar%a%init()
! They should be called once
if (count1 /= 23 .or. count2 /= 42) call abort ()
contains
subroutine dummy1
implicit none
!print *, 'dummy1'
count1 = 23
end subroutine dummy1
subroutine dummy2
implicit none
!print *, 'dummy2'
count2 = 42
end subroutine dummy2
subroutine setme
use foo, only: bar, cg_ext
implicit none
procedure(cg_ext), pointer :: a_init, a_clean
a_init => dummy1
a_clean => dummy2
call bar%epa_init(a_init, a_clean)
end subroutine setme
end program ala
! { dg-final { scan-tree-dump-times "ext_ptr.\[0-9\]+.init = 0B;" 1 "original" } }
! { dg-final { scan-tree-dump-times "ext_ptr.\[0-9\]+.cleanup = 0B;" 1 "original" } }
! { dg-final { scan-tree-dump-times "ext_ptr.1.init = \\*init;" 1 "original" } }
! { dg-final { scan-tree-dump-times "ext_ptr.1.cleanup = \\*cleanup;" 1 "original" } }
! { dg-final { scan-tree-dump-times "this->_data->a.init = \\*init;" 1 "original" } }
! { dg-final { scan-tree-dump-times "this->_data->a.cleanup = \\*cleanup;" 1 "original" } }
! { dg-final { scan-tree-dump-times "ext_ptr.\[0-9\]+.init = this->_data->a.init;" 1 "original" } }
! { dg-final { scan-tree-dump-times "ext_ptr.\[0-9\]+.cleanup = this->_data->a.cleanup;" 1 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
|
