! { dg-do run }
! Test the fix for pr69011, preventing an ICE and making sure
! that the correct dynamic type is used.
!
! Contributed by Thomas Koenig  <tkoenig@gcc.gnu.org>
!                Andre Vehreschild  <vehre@gcc.gnu.org>
!
 
module m1
implicit none
private
public :: basetype

type:: basetype
  integer :: i
  contains
endtype basetype

abstract interface
endinterface

endmodule m1

module m2
use m1, only : basetype
implicit none
integer, parameter :: I_P = 4

private
public :: factory, exttype

type, extends(basetype) :: exttype
  integer :: i2
  contains
endtype exttype

type :: factory
  integer(I_P) :: steps=-1 
  contains
    procedure, pass(self), public :: construct
endtype factory
contains

  function construct(self, previous)
  class(basetype), intent(INOUT) :: previous(1:)
  class(factory), intent(IN) :: self
  class(basetype), pointer :: construct
  allocate(construct, source=previous(self%steps))
  endfunction construct
endmodule m2

  use m2
  use m1
  class(factory), allocatable :: c1
  class(exttype), allocatable :: prev(:)
  class(basetype), pointer :: d

  allocate(c1)
  allocate(prev(2))
  prev(:)%i = [ 2, 3]
  prev(:)%i2 = [ 5, 6]
  c1%steps= 1
  d=> c1%construct(prev)

  if (.not. associated(d) ) STOP 1
  select type (d)
    class is (exttype)
      if (d%i2 /= 5) STOP 2
    class default
      STOP 3
  end select 
  if (d%i /= 2) STOP 4
  deallocate(c1)
  deallocate(prev)
  deallocate(d)
end