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