https://gcc.gnu.org/bugzilla/show_bug.cgi?id=79344
--- Comment #3 from Jürgen Reuter <juergen.reuter at desy dot de> --- Finally reduced this to something like 260 lines. Problem is the allocate source construct, i.e. copying of allocatable derived type components. module iso_varying_string implicit none integer, parameter, private :: GET_BUFFER_LEN = 1 type, public :: varying_string private character(LEN=1), dimension(:), allocatable :: chars end type varying_string interface assignment(=) module procedure op_assign_CH_VS module procedure op_assign_VS_CH end interface assignment(=) interface char module procedure char_auto module procedure char_fixed end interface char interface len module procedure len_ end interface len interface var_str module procedure var_str_ end interface var_str public :: assignment(=) public :: char public :: len public :: var_str private :: op_assign_CH_VS private :: op_assign_VS_CH private :: char_auto private :: char_fixed private :: len_ private :: var_str_ contains elemental function len_ (string) result (length) type(varying_string), intent(in) :: string integer :: length if(ALLOCATED(string%chars)) then length = SIZE(string%chars) else length = 0 endif end function len_ elemental subroutine op_assign_CH_VS (var, exp) character(LEN=*), intent(out) :: var type(varying_string), intent(in) :: exp var = char(exp) end subroutine op_assign_CH_VS elemental subroutine op_assign_VS_CH (var, exp) type(varying_string), intent(out) :: var character(LEN=*), intent(in) :: exp var = var_str(exp) end subroutine op_assign_VS_CH pure function char_auto (string) result (char_string) type(varying_string), intent(in) :: string character(LEN=len(string)) :: char_string integer :: i_char forall(i_char = 1:len(string)) char_string(i_char:i_char) = string%chars(i_char) end forall end function char_auto pure function char_fixed (string, length) result (char_string) type(varying_string), intent(in) :: string integer, intent(in) :: length character(LEN=length) :: char_string char_string = char(string) return end function char_fixed elemental function var_str_ (char) result (string) character(LEN=*), intent(in) :: char type(varying_string) :: string integer :: length integer :: i_char length = LEN(char) ALLOCATE(string%chars(length)) forall(i_char = 1:length) string%chars(i_char) = char(i_char:i_char) end forall end function var_str_ end module iso_varying_string !!!!! module models use iso_varying_string, string_t => varying_string implicit none private public :: field_data_t public :: model_data_t type :: field_data_t private type(string_t) :: longname integer :: pdg = 0 type(string_t), dimension(:), allocatable :: name, anti contains procedure :: init => field_data_init procedure :: copy_from => field_data_copy_from procedure :: set => field_data_set end type field_data_t type :: field_data_p type(field_data_t), pointer :: p => null () end type field_data_p type :: model_data_t private type(string_t) :: name type(field_data_t), dimension(:), allocatable :: field contains procedure :: get_field_ptr_by_index => model_data_get_field_ptr_index end type model_data_t public :: model_t type, extends (model_data_t) :: model_t contains generic :: init => model_init procedure, private :: model_init procedure :: read => model_read end type model_t contains subroutine field_data_init (prt, longname, pdg) class(field_data_t), intent(out) :: prt type(string_t), intent(in) :: longname integer, intent(in) :: pdg prt%longname = longname prt%pdg = pdg end subroutine field_data_init subroutine field_data_copy_from (prt, prt_src) class(field_data_t), intent(inout) :: prt class(field_data_t), intent(in) :: prt_src integer :: i print *, "##############################################################" print *, "inside copy_from" if (allocated (prt_src%name)) then print *, "foo" do i = 1, size (prt_src%name) print *, "name = ", char (prt_src%name(i)) end do if (allocated (prt%name)) deallocate (prt%name) allocate (prt%name (size (prt_src%name)), source = prt_src%name) print *, "THESE SHOULD NOT BE EMPTY" do i = 1, size (prt_src%name) print *, "name = ", char (prt_src%name(i)) end do end if if (allocated (prt_src%anti)) then if (allocated (prt%anti)) deallocate (prt%anti) allocate (prt%anti (size (prt_src%anti)), source = prt_src%anti) end if end subroutine field_data_copy_from subroutine field_data_set (prt, name, anti) class(field_data_t), intent(inout) :: prt type(string_t), dimension(:), intent(in), optional :: name, anti if (present (name)) then if (allocated (prt%name)) deallocate (prt%name) allocate (prt%name (size (name)), source = name) end if end subroutine field_data_set function model_data_get_field_ptr_index (model, i) result (ptr) class(model_data_t), intent(in), target :: model integer, intent(in) :: i type(field_data_t), pointer :: ptr ptr => model%field(i) end function model_data_get_field_ptr_index subroutine model_init & (model, name, n_par, n_prt) class(model_t), intent(inout) :: model type(string_t), intent(in) :: name integer, intent(in) :: n_par, n_prt model%name = name allocate (model%field (n_prt)) end subroutine model_init subroutine model_read (model) class(model_t), intent(out), target :: model type(field_data_t), pointer :: field, field_src call model%init (var_str ("foo"), 0, 2) field_src => model%get_field_ptr_by_index (1) call field_src%init (var_str ("E_LEPTON"), 11) call field_src%set & (name = [var_str ("e-"), var_str ("e1")]) field => model%get_field_ptr_by_index (2) call field%init (var_str ("MU_LEPTON"), 13) call field%copy_from (field_src) end subroutine model_read end module models !!!!! program main_ut use iso_varying_string, string_t => varying_string use models implicit none class(model_data_t), pointer :: model allocate (model_t :: model) select type (model) type is (model_t) call model%read () end select end program main_ut