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
