1132943Sgshapiro! { dg-do run } 2261363Sgshapiro! 3132943Sgshapiro! PR fortran/47455 4132943Sgshapiro! 5132943Sgshapiro! Based on an example by Thomas Henlich 6132943Sgshapiro! 7132943Sgshapiro 8132943Sgshapiromodule class_t 9132943Sgshapiro type :: tx 10132943Sgshapiro integer, dimension(:), allocatable :: i 11132943Sgshapiro end type tx 12132943Sgshapiro type :: t 13132943Sgshapiro type(tx), pointer :: x 14132943Sgshapiro type(tx) :: y 15132943Sgshapiro contains 16132943Sgshapiro procedure :: calc 17132943Sgshapiro procedure :: find_x 18132943Sgshapiro procedure :: find_y 19132943Sgshapiro end type t 20132943Sgshapirocontains 21132943Sgshapiro subroutine calc(this) 22132943Sgshapiro class(t), target :: this 23132943Sgshapiro type(tx), target :: that 24132943Sgshapiro that%i = [1,2] 25132943Sgshapiro this%x => this%find_x(that, .true.) 26132943Sgshapiro if (associated (this%x)) call abort() 27132943Sgshapiro this%x => this%find_x(that, .false.) 28132943Sgshapiro if(any (this%x%i /= [5, 7])) call abort() 29132943Sgshapiro if (.not.associated (this%x,that)) call abort() 30132943Sgshapiro allocate(this%x) 31132943Sgshapiro if (associated (this%x,that)) call abort() 32132943Sgshapiro if (allocated(this%x%i)) call abort() 33132943Sgshapiro this%x = this%find_x(that, .false.) 34132943Sgshapiro that%i = [3,4] 35132943Sgshapiro if(any (this%x%i /= [5, 7])) call abort() ! FAILS 36132943Sgshapiro 37132943Sgshapiro if (allocated (this%y%i)) call abort() 38132943Sgshapiro this%y = this%find_y() ! FAILS 39132943Sgshapiro if (.not.allocated (this%y%i)) call abort() 40132943Sgshapiro if(any (this%y%i /= [6, 8])) call abort() 41132943Sgshapiro end subroutine calc 42132943Sgshapiro function find_x(this, that, l_null) 43132943Sgshapiro class(t), intent(in) :: this 44132943Sgshapiro type(tx), target :: that 45132943Sgshapiro type(tx), pointer :: find_x 46132943Sgshapiro logical :: l_null 47132943Sgshapiro if (l_null) then 48266692Sgshapiro find_x => null() 49132943Sgshapiro else 50132943Sgshapiro find_x => that 51132943Sgshapiro that%i = [5, 7] 52132943Sgshapiro end if 53132943Sgshapiro end function find_x 54132943Sgshapiro function find_y(this) result(res) 55132943Sgshapiro class(t), intent(in) :: this 56132943Sgshapiro type(tx), allocatable :: res 57132943Sgshapiro allocate(res) 58132943Sgshapiro res%i = [6, 8] 59157001Sgshapiro end function find_y 60132943Sgshapiroend module class_t 61132943Sgshapiro 62132943Sgshapirouse class_t 63132943Sgshapirotype(t) :: x 64132943Sgshapirocall x%calc() 65132943Sgshapiroend 66132943Sgshapiro