mirror of
https://github.com/autc04/Retro68.git
synced 2024-06-28 11:30:19 +00:00
96 lines
2.5 KiB
Fortran
96 lines
2.5 KiB
Fortran
! { 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) STOP 1
|
|
|
|
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" } }
|