(root)/
gcc-13.2.0/
gcc/
testsuite/
gfortran.dg/
class_48.f90
! { 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