1! { dg-do run } 2! 3! PR fortran/57530 4! 5! 6! CLASS => CLASS pointer assignment for function results 7! 8module m 9 implicit none 10 type t 11 integer :: ii = 55 12 end type t 13 type, extends(t) :: t2 14 end type t2 15contains 16 function f1() 17 class(t), pointer :: f1 18 allocate (f1) 19 f1%ii = 123 20 end function f1 21 function f2() 22 class(t), pointer :: f2(:) 23 allocate (f2(3)) 24 f2(:)%ii = [-11,-22,-33] 25 end function f2 26end module m 27 28program test 29 use m 30 implicit none 31 class(t), pointer :: p1, p2(:), p3(:,:) 32 type(t) :: my_t 33 type(t2) :: my_t2 34 35 allocate (t2 :: p1, p2(1), p3(1,1)) 36 if (.not. same_type_as (p1, my_t2)) call abort() 37 if (.not. same_type_as (p2, my_t2)) call abort() 38 if (.not. same_type_as (p3, my_t2)) call abort() 39 40 p1 => f1() 41 if (p1%ii /= 123) call abort () 42 if (.not. same_type_as (p1, my_t)) call abort() 43 44 p2 => f2() 45 if (any (p2%ii /= [-11,-22,-33])) call abort () 46 if (.not. same_type_as (p2, my_t)) call abort() 47 48 p3(2:2,1:3) => f2() 49 if (any (p3(2,:)%ii /= [-11,-22,-33])) call abort () 50 if (.not. same_type_as (p3, my_t)) call abort() 51end program test 52