module TYPES

  implicit none

  type BASE_TYPE
#ifdef __REM_ALLOC_COMPO__
     integer :: FIELD0 = 0
#else
     integer, dimension(:), allocatable :: ALLOC_FIELD0 ! crash disappears if allocatable component suppressed 
#endif
#ifdef __ASSIGN_OVERL__
  contains
    ! crash disappears if assignment overloading is used
    procedure :: BASE_TYPE_ASSIGN
    generic :: assignment(=) => BASE_TYPE_ASSIGN
#endif
  end type BASE_TYPE

  type, extends(BASE_TYPE) :: TYPE1
     integer :: FIELD1 = 0
#ifdef __ASSIGN_OVERL__
  contains
    ! crash disappears if assignment overloading is used
    procedure :: TYPE1_ASSIGN
    generic :: assignment(=) => TYPE1_ASSIGN
#endif
  end type TYPE1

  type, extends(BASE_TYPE) :: TYPE2
     integer :: FIELD2 = 0
#ifdef __ASSIGN_OVERL__
  contains
    ! crash disappears if assignment overloading is used
    procedure :: TYPE2_ASSIGN
    generic :: assignment(=) => TYPE2_ASSIGN
#endif
  end type TYPE2

contains
#ifdef __ASSIGN_OVERL__

  !                    #=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#

  !> Assign second BASE_TYPE to first BASE_TYPE
  subroutine BASE_TYPE_ASSIGN(DATA1,DATA2)

    !> first BASE_TYPE
    class(BASE_TYPE), intent(inout) :: DATA1
    !> second BASE_TYPE
    type(BASE_TYPE), intent(in) :: DATA2


#ifdef __REM_ALLOC_COMPO__
    DATA1%FIELD0 = DATA2%FIELD0
#else
    if (allocated(DATA2%ALLOC_FIELD0)) DATA1%ALLOC_FIELD0 = DATA2%ALLOC_FIELD0
#endif

  end subroutine BASE_TYPE_ASSIGN

  !                    #=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#

  !> Assign second TYPE1 to first TYPE1
  subroutine TYPE1_ASSIGN(DATA1,DATA2)

    !> first TYPE1
    class(TYPE1), intent(inout) :: DATA1
    !> second TYPE1
    type(TYPE1), intent(in) :: DATA2


    DATA1%BASE_TYPE = DATA2%BASE_TYPE
    DATA1%FIELD1 = DATA2%FIELD1

  end subroutine TYPE1_ASSIGN

  !                    #=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#

  !> Assign second TYPE2 to first TYPE2
  subroutine TYPE2_ASSIGN(DATA1,DATA2)

    !> first TYPE2
    class(TYPE2), intent(inout) :: DATA1
    !> second TYPE2
    type(TYPE2), intent(in) :: DATA2


    DATA1%BASE_TYPE = DATA2%BASE_TYPE
    DATA1%FIELD2 = DATA2%FIELD2

  end subroutine TYPE2_ASSIGN

  !                    #=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#
#endif

#ifdef __MODUL_MERGED__
#else
end module TYPES



module TYPES_COPY ! crash disappears if module TYPES_COPY merged with module TYPES

  use TYPES, only : TYPE1, TYPE2

  implicit none

contains

  !                    #=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#
#endif

#ifdef __REM_COPY_ROUT__
#else
  subroutine COPY_TYPE2_TO_TYPE1(TYPE2_VAR) ! crash disappears if routine COPY_TYPE2_TO_TYPE1 suppressed

    type(TYPE2), intent(in) :: TYPE2_VAR

    type(TYPE1) :: TYPE1_VAR


    TYPE1_VAR%BASE_TYPE = TYPE2_VAR%BASE_TYPE

  end subroutine COPY_TYPE2_TO_TYPE1

  !                    #=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#
#endif

  subroutine COPY_TYPE1_TO_TYPE2(TYPE1_VAR)
  
    type(TYPE1), intent(in) :: TYPE1_VAR
    
    type(TYPE2) :: TYPE2_VAR


    TYPE2_VAR%BASE_TYPE = TYPE1_VAR%BASE_TYPE

  end subroutine COPY_TYPE1_TO_TYPE2

  !                    #=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#

#ifdef __MODUL_MERGED__
end module TYPES

#else
end module TYPES_COPY

#endif


program MAIN

  use TYPES, only : TYPE1
#ifdef __MODUL_MERGED__
  use TYPES, only : COPY_TYPE1_TO_TYPE2
#else
  use TYPES_COPY, only : COPY_TYPE1_TO_TYPE2
#endif

  implicit none

  type(TYPE1) :: TYPE1_VAR

  write(6,*) "before COPY_TYPE1_TO_TYPE2"
#ifdef __REM_ALLOC_COMPO__
#else
  TYPE1_VAR%ALLOC_FIELD0 = [ 0, 1 ]
#endif
  call COPY_TYPE1_TO_TYPE2(TYPE1_VAR) ! crash disappears if TYPE2_VAR%BASE_TYPE = TYPE1_VAR%BASE_TYPE made directly here
  write(6,*) "after COPY_TYPE1_TO_TYPE2"

end program MAIN
