Regression in ifort19: seg fault on allocatable array operations

[Juergen_R_R]

Unfortunately, there was quite some regression in the beta release of ifort v19 which lets ca. 10 of our unit tests and ca. 20 of our functional tests fail with segmentation faults. We think/hope that this is only one bug/regression. I reported this as support item 03384851 to the Intel Support. Unfortunately, the regression was not yet fixed within the Update 1 of the beta version. Hopefully (fingers crossed) this gets fixed for the official release. In v17 there were many regressions at the beginning so we had to special case our build environment to veto v17.0.0/1/2/3 and only allow v17.0.4 onwards. v18 came with some regression (IIRC) that was fixed, however, before the official release came out. We hope very much that this will happen for v19 as well. Here is the code leading to the problem:

module resonances
  implicit none
  private
  public :: t2
  public :: t3
  public :: t4
  type, public :: string_t
     private
     character(LEN=1), dimension(:), allocatable :: chars
  end type string_t

  type :: t1
     integer, dimension(:), allocatable :: c
   contains
     procedure, private :: t1_assign
     generic :: assignment(=) => t1_assign
  end type t1

  type :: t2
     type(t1) :: contributors
  contains
     procedure :: copy => resonance_info_copy
     procedure :: init => resonance_info_init
  end type t2

  type :: t3
     type(t2), dimension(:), allocatable :: resonances
     integer :: n_resonances = 0
  contains
     procedure :: copy => resonance_history_copy
     procedure :: add_resonance => resonance_history_add_resonance
  end type t3

  type :: t4
     private
     type(t3), dimension(:), allocatable :: history
     integer :: last = 0
   contains
     procedure :: init => t4_init
     procedure :: enter => t4_enter
  end type t4

contains

  pure subroutine t1_assign (contributors_out, contributors_in)
    class(t1), intent(inout) :: contributors_out
    class(t1), intent(in) :: contributors_in
    if (allocated (contributors_out%c))  deallocate (contributors_out%c)
    if (allocated (contributors_in%c)) then
       contributors_out%c = contributors_in%c
    end if
  end subroutine t1_assign

  subroutine resonance_info_copy (resonance_in, resonance_out)
    class(t2), intent(in) :: resonance_in
    type(t2), intent(out) :: resonance_out
    if (allocated (resonance_in%contributors%c)) then
       associate (c => resonance_in%contributors%c)
          resonance_out%contributors%c = c
       end associate
    end if
  end subroutine resonance_info_copy

  subroutine resonance_info_init (resonance, mom_id, pdg, n_out)
    class(t2), intent(out) :: resonance
    integer, intent(in) :: mom_id
    integer, intent(in) :: pdg, n_out
    type(string_t) :: head_footer
    integer :: i
    integer, dimension(n_out) :: tmp
    logical, dimension(n_out) :: contrib    
!!!! Commenting out this one makes it go away
    head_footer  = var_str_("******************************************************************************")        
    do i = 1, n_out
       tmp(i) = i
    end do
    contrib = btest (mom_id, tmp - 1)
    allocate (resonance%contributors%c (count (contrib)))
    resonance%contributors%c = pack (tmp, contrib)    
  end subroutine resonance_info_init

  subroutine resonance_history_copy (res_hist_in, res_hist_out)
    class(t3), intent(in) :: res_hist_in
    type(t3), intent(out) :: res_hist_out
    integer :: i
    res_hist_out%n_resonances = res_hist_in%n_resonances
    res_hist_out%resonances = res_hist_in%resonances    
  end subroutine resonance_history_copy

  subroutine resonance_history_add_resonance (res_hist, resonance)
    class(t3), intent(inout) :: res_hist
    type(t2), intent(in) :: resonance
    type(t2), dimension(:), allocatable :: tmp
    integer :: n, i
    if (.not. allocated (res_hist%resonances)) then
       n = 0
       allocate (res_hist%resonances (1))
    else
       n = res_hist%n_resonances
       allocate (tmp (n))
       do i = 1, n
          call res_hist%resonances(i)%copy (tmp(i))
       end do
       deallocate (res_hist%resonances)
       allocate (res_hist%resonances (n+1))
       do i = 1, n
          call tmp(i)%copy (res_hist%resonances(i))
       end do
       deallocate (tmp)
    end if
    call resonance%copy (res_hist%resonances(n+1))
    res_hist%n_resonances = n + 1
  end subroutine resonance_history_add_resonance

  subroutine t4_init (res_set, initial_size)
    class(t4), intent(out) :: res_set
    integer, intent(in) :: initial_size
    allocate (res_set%history (initial_size))
  end subroutine t4_init

  subroutine t4_enter (res_set, res_history, trivial)
    class(t4), intent(inout) :: res_set
    type(t3), intent(in) :: res_history
    logical, intent(in), optional :: trivial
    integer :: i, new
    new = res_set%last + 1
    res_set%history(new) = res_history
  end subroutine t4_enter

  elemental function var_str_ (char) result (string)
    character(LEN=*), intent(in) :: char
    type(string_t) :: 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 resonances

!!!!!

program main_ut
  use resonances
  implicit none
  call resonances_3 ()
contains
  subroutine resonances_3 ()
    type(t2) :: res_info
    type(t3) :: res_history
    type(t3), dimension(:), allocatable :: res_histories
    type(t4) :: res_set
    integer :: i
    call res_set%init (initial_size = 2)
    call res_set%enter (res_history)
    call res_info%init (3, -24, 5)
    call res_history%add_resonance (res_info)
    call res_set%enter (res_history)
  end subroutine resonances_3  
end program main_ut

[Juergen_R_R]

Intel support informed me that this issue has been fixed by the developers, and the fix will be available for the official release of the v19 of the compiler. So that is great news, I am eager to test the official version.