[Bug fortran/65894] [6 Regression] severe regression in gfortran 6.0.0

["juergen.reuter at desy dot de" <gcc-bugzilla at gcc dot gnu dot org>]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=65894

--- Comment #5 from JÃrgen Reuter <juergen.reuter at desy dot de> ---
Here is a reduced test case (where iso_varying_string.f90 is the standard
module with 1 or 2 modifications by us). As this is at the core of our program,
we do rely on a timely fix in order to further use and test gfortran 6.0.



module model_data
  use iso_varying_string, string_t => varying_string

  implicit none
  private

  public :: field_data_t
  public :: model_data_t

  type :: field_data_t
     private
     integer :: pdg = 0
     type(string_t), dimension(:), allocatable :: name
   contains
     procedure :: init => field_data_init
     procedure :: get_pdg => field_data_get_pdg
  end type field_data_t

  type :: model_data_t
     private
     type(string_t) :: name
     type(field_data_t), dimension(:), allocatable :: field
   contains
     generic :: init => model_data_init
     procedure, private :: model_data_init
     generic :: get_pdg => &
          model_data_get_field_pdg_index
     procedure, private :: model_data_get_field_pdg_index
     generic :: get_field_ptr => &
          model_data_get_field_ptr_pdg
     procedure, private :: model_data_get_field_ptr_pdg
     procedure :: get_field_ptr_by_index => model_data_get_field_ptr_index
     procedure :: init_sm_test => model_data_init_sm_test
  end type model_data_t


contains

  subroutine field_data_init (prt, pdg)
    class(field_data_t), intent(out) :: prt
    integer, intent(in) :: pdg
    prt%pdg = pdg
  end subroutine field_data_init

  elemental function field_data_get_pdg (prt) result (pdg)
    integer :: pdg
    class(field_data_t), intent(in) :: prt
    pdg = prt%pdg
  end function field_data_get_pdg

  subroutine model_data_init (model, name, &
       n_field)
    class(model_data_t), intent(out) :: model
    type(string_t), intent(in) :: name
    integer, intent(in) :: n_field
    model%name = name
    allocate (model%field (n_field))
  end subroutine model_data_init

  function model_data_get_field_pdg_index (model, i) result (pdg)
    class(model_data_t), intent(in) :: model
    integer, intent(in) :: i
    integer :: pdg
    pdg = model%field(i)%get_pdg ()
  end function model_data_get_field_pdg_index

  function model_data_get_field_ptr_pdg (model, pdg, check) result (ptr)
    class(model_data_t), intent(in), target :: model
    integer, intent(in) :: pdg
    logical, intent(in), optional :: check
    type(field_data_t), pointer :: ptr
    integer :: i, pdg_abs
    if (pdg == 0) then
       ptr => null ()
       return
    end if
    pdg_abs = abs (pdg)
    do i = 1, size (model%field)
       if (model%field(i)%get_pdg () == pdg_abs) then
          ptr => model%field(i)
          return
       end if
    end do
    ptr => null ()
  end function model_data_get_field_ptr_pdg

  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_data_init_sm_test (model)
    class(model_data_t), intent(out) :: model
    type(field_data_t), pointer :: field
    integer, parameter :: n_field = 19
    call model%init (var_str ("SM_test"), &
         n_field)
    field => model%get_field_ptr_by_index (1)
    call field%init (1)
  end subroutine model_data_init_sm_test

end module model_data


module flavors
  use model_data

  implicit none
  private

  public :: flavor_t

  type :: flavor_t
     private
     integer :: f = 0
     type(field_data_t), pointer :: field_data => null ()
   contains
     generic :: init => &
          flavor_init0_model
     procedure, private :: flavor_init0_model
  end type flavor_t

contains

  impure elemental subroutine flavor_init0_model (flv, f, model)
    class(flavor_t), intent(inout) :: flv
    integer, intent(in) :: f
    class(model_data_t), intent(in), target :: model
    flv%f = f
    flv%field_data => model%get_field_ptr (f, check=.true.)
  end subroutine flavor_init0_model
end module flavors

module beams
  use model_data
  use flavors
  implicit none
  private
  public :: beam_1
contains
  subroutine beam_1 (u)
    integer, intent(in) :: u
    type(flavor_t), dimension(2) :: flv
    real, dimension(2) :: pol_f
    type(model_data_t), target :: model
    call model%init_sm_test ()   
    call flv%init ([1,-1], model)
    pol_f(1) = 0.5
  end subroutine beam_1
end module beams

program main
  use beams
  call beam_1 (6)
end program main