1! { dg-do run }
2! { dg-options "-fdump-tree-original" }
3!
4! PR fortran/54603
5!
6! Contributed by Kacper Kowalik
7!
8module foo
9   implicit none
10
11   interface
12      subroutine cg_ext
13         implicit none
14      end subroutine cg_ext
15   end interface
16
17   type :: ext_ptr
18      procedure(cg_ext), nopass, pointer :: init
19      procedure(cg_ext), nopass, pointer :: cleanup
20   end type ext_ptr
21
22   type :: ext_ptr_array
23      type(ext_ptr) :: a
24      contains
25         procedure :: epa_init
26   end type ext_ptr_array
27
28   type(ext_ptr_array) :: bar
29
30contains
31   subroutine epa_init(this, init, cleanup)
32      implicit none
33      class(ext_ptr_array), intent(inout) :: this
34      procedure(cg_ext), pointer, intent(in)    :: init
35      procedure(cg_ext), pointer, intent(in)    :: cleanup
36
37      this%a = ext_ptr(null(), null())  ! Wrong code
38      this%a = ext_ptr(init, cleanup)  ! Wrong code
39
40      this%a%init => init              ! OK
41      this%a%cleanup => cleanup        ! OK
42
43      this%a = ext_ptr(this%a%init,this%a%cleanup) ! ICE in fold_convert_loc
44   end subroutine epa_init
45
46end module foo
47
48program ala
49   use foo, only: bar
50   implicit none
51   integer :: count1, count2
52   count1 = 0
53   count2 = 0
54
55   call setme
56   call bar%a%cleanup()
57   call bar%a%init()
58
59   ! They should be called once
60   if (count1 /= 23 .or. count2 /= 42) call abort ()
61
62contains
63
64   subroutine dummy1
65      implicit none
66      !print *, 'dummy1'
67      count1 = 23
68   end subroutine dummy1
69
70   subroutine dummy2
71      implicit none
72      !print *, 'dummy2'
73      count2 = 42
74   end subroutine dummy2
75
76   subroutine setme
77      use foo, only: bar, cg_ext
78      implicit none
79      procedure(cg_ext), pointer :: a_init, a_clean
80
81      a_init => dummy1
82      a_clean => dummy2
83      call bar%epa_init(a_init, a_clean)
84   end subroutine setme
85
86end program ala
87
88! { dg-final { scan-tree-dump-times "ext_ptr.\[0-9\]+.init = 0B;" 1 "original" } }
89! { dg-final { scan-tree-dump-times "ext_ptr.\[0-9\]+.cleanup = 0B;" 1 "original" } }
90! { dg-final { scan-tree-dump-times "ext_ptr.1.init = \\*init;" 1 "original" } }
91! { dg-final { scan-tree-dump-times "ext_ptr.1.cleanup = \\*cleanup;" 1 "original" } }
92! { dg-final { scan-tree-dump-times "this->_data->a.init = \\*init;" 1 "original" } }
93! { dg-final { scan-tree-dump-times "this->_data->a.cleanup = \\*cleanup;" 1 "original" } }
94! { dg-final { scan-tree-dump-times "ext_ptr.\[0-9\]+.init = this->_data->a.init;" 1 "original" } }
95! { dg-final { scan-tree-dump-times "ext_ptr.\[0-9\]+.cleanup = this->_data->a.cleanup;" 1 "original" } }
96! { dg-final { cleanup-tree-dump "original" } }
97