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