! { dg-do run } ! ! PR fortran/51972 ! Also tests fixes for PR52102 ! ! Check whether DT assignment with polymorphic components works. ! subroutine test1 () type t integer :: x end type t type t2 class(t), allocatable :: a end type t2 type(t2) :: one, two one = two if (allocated (one%a)) STOP 1 allocate (two%a) two%a%x = 7890 one = two if (one%a%x /= 7890) STOP 2 deallocate (two%a) one = two if (allocated (one%a)) STOP 3 end subroutine test1 subroutine test2 () type t integer, allocatable :: x(:) end type t type t2 class(t), allocatable :: a end type t2 type(t2) :: one, two one = two if (allocated (one%a)) STOP 4 allocate (two%a) one = two if (.not.allocated (one%a)) STOP 5 if (allocated (one%a%x)) STOP 6 allocate (two%a%x(2)) two%a%x(:) = 7890 one = two if (any (one%a%x /= 7890)) STOP 7 deallocate (two%a) one = two if (allocated (one%a)) STOP 8 end subroutine test2 subroutine test3 () type t integer :: x end type t type t2 class(t), allocatable :: a(:) end type t2 type(t2) :: one, two ! Test allocate with array source - PR52102 allocate (two%a(2), source = [t(4), t(6)]) if (allocated (one%a)) STOP 9 one = two if (.not.allocated (one%a)) STOP 10 if ((one%a(1)%x /= 4)) STOP 11 if ((one%a(2)%x /= 6)) STOP 12 deallocate (two%a) one = two if (allocated (one%a)) STOP 13 ! Test allocate with no source followed by assignments. allocate (two%a(2)) two%a(1)%x = 5 two%a(2)%x = 7 if (allocated (one%a)) STOP 14 one = two if (.not.allocated (one%a)) STOP 15 if ((one%a(1)%x /= 5)) STOP 16 if ((one%a(2)%x /= 7)) STOP 17 deallocate (two%a) one = two if (allocated (one%a)) STOP 18 end subroutine test3 subroutine test4 () type t integer, allocatable :: x(:) end type t type t2 class(t), allocatable :: a(:) end type t2 type(t2) :: one, two if (allocated (one%a)) STOP 19 if (allocated (two%a)) STOP 20 allocate (two%a(2)) if (allocated (two%a(1)%x)) STOP 21 if (allocated (two%a(2)%x)) STOP 22 allocate (two%a(1)%x(3), source=[1,2,3]) allocate (two%a(2)%x(5), source=[5,6,7,8,9]) one = two if (.not. allocated (one%a)) STOP 23 if (.not. allocated (one%a(1)%x)) STOP 24 if (.not. allocated (one%a(2)%x)) STOP 25 if (size(one%a) /= 2) STOP 26 if (size(one%a(1)%x) /= 3) STOP 27 if (size(one%a(2)%x) /= 5) STOP 28 if (any (one%a(1)%x /= [1,2,3])) STOP 29 if (any (one%a(2)%x /= [5,6,7,8,9])) STOP 30 deallocate (two%a(1)%x) one = two if (.not. allocated (one%a)) STOP 31 if (allocated (one%a(1)%x)) STOP 32 if (.not. allocated (one%a(2)%x)) STOP 33 if (size(one%a) /= 2) STOP 34 if (size(one%a(2)%x) /= 5) STOP 35 if (any (one%a(2)%x /= [5,6,7,8,9])) STOP 36 deallocate (two%a) one = two if (allocated (one%a)) STOP 37 if (allocated (two%a)) STOP 38 end subroutine test4 call test1 () call test2 () call test3 () call test4 () end