[Bug fortran/59941] New: ICE with polymorphic types in [4.7.0|4.7.1|4.73|4.7.4]

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

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=59941

            Bug ID: 59941
           Summary: ICE with polymorphic types in [4.7.0|4.7.1|4.73|4.7.4]
           Product: gcc
           Version: 4.7.4
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
          Assignee: unassigned at gcc dot gnu.org
          Reporter: juergen.reuter at desy dot de

This is the code that triggers the ICE:
$ gfortran -c ICE.f90
f951: internal compiler error: Segmentation fault
Please submit a full bug report,
with preprocessed source if appropriate.
See <http://gcc.gnu.org/bugs.html> for instructions.

Here is the code (also attached, 147 lines):


module tao_random_numbers
  integer, parameter, private :: tao_i32 = selected_int_kind (9)
  integer, parameter, private :: DEFAULT_BUFFER_SIZE = 1009
  integer(kind=tao_i32), dimension(DEFAULT_BUFFER_SIZE), save, private ::
s_buffer
  integer, save, private :: s_buffer_end = size (s_buffer)
end module tao_random_numbers

!!!!

module interactions
  public :: interaction_t

  type :: external_link_t
     type(interaction_t), pointer :: int => null ()
  end type external_link_t

  type :: interaction_t
     type(external_link_t), dimension(:), allocatable :: source
  end type interaction_t

end module interactions

!!!!!

module polarizations
  public :: smatrix_t
  public :: pmatrix_t

  type :: smatrix_t
     integer :: dim = 0
     integer, dimension(:,:), allocatable :: index
  end type smatrix_t

  type, extends (smatrix_t) :: pmatrix_t
   contains
     procedure :: p_from_s => pmatrix_assign_from_smatrix
  end type pmatrix_t

contains

  subroutine pmatrix_assign_from_smatrix (pmatrix, smatrix)
    class(pmatrix_t), intent(out) :: pmatrix
    type(smatrix_t), intent(in) :: smatrix
    pmatrix%smatrix_t = smatrix
  end subroutine pmatrix_assign_from_smatrix

end module polarizations

!!!!!

module beam_structures
  use polarizations
  public :: beam_structure_t

  type :: beam_structure_entry_t
     logical :: is_valid = .false.
  end type beam_structure_entry_t

  type :: beam_structure_record_t
     type(beam_structure_entry_t), dimension(:), allocatable :: entry
  end type beam_structure_record_t

  type :: beam_structure_t
     private
     integer :: n_beam = 0
     type(beam_structure_record_t), dimension(:), allocatable :: record
     type(smatrix_t), dimension(:), allocatable :: smatrix
   contains
     procedure :: get_smatrix => beam_structure_get_smatrix
  end type beam_structure_t

contains

  function beam_structure_get_smatrix (beam_structure) result (smatrix)
    class(beam_structure_t), intent(in) :: beam_structure
    type(smatrix_t), dimension (size (beam_structure%smatrix)) :: smatrix
    smatrix = beam_structure%smatrix
  end function beam_structure_get_smatrix

end module beam_structures

!!!!

module beams
  use polarizations
  use beam_structures
  public :: beam_data_t
  type :: beam_data_t
     type(pmatrix_t), dimension(:), allocatable :: pmatrix
  end type beam_data_t
end module beams

!!!!!

module sf_base
  use interactions
  use beams
  public :: sf_data_t
  public :: sf_int_t

  type, abstract :: sf_data_t
  end type sf_data_t

  type, abstract, extends (interaction_t) :: sf_int_t
   contains
     procedure (sf_int_init), deferred :: init
  end type sf_int_t

  abstract interface
     subroutine sf_int_init (sf_int, data)
       import
       class(sf_int_t), intent(out) :: sf_int
       class(sf_data_t), intent(in), target :: data
     end subroutine sf_int_init
  end interface
end module sf_base

!!!!!

module sf_circe1
  use tao_random_numbers !NODEP!
  use sf_base

  type, extends (sf_data_t) :: circe1_data_t 
     private 
   contains  
       procedure :: init => circe1_data_init 
  end type circe1_data_t 

  type, extends (sf_int_t) :: circe1_t
     type(circe1_data_t), pointer :: data => null ()
   contains
     procedure :: init => circe1_init
  end type circe1_t 

contains

  subroutine circe1_data_init (data)
    class(circe1_data_t), intent(out) :: data 
  end subroutine circe1_data_init 

  subroutine circe1_init (sf_int, data) 
    class(circe1_t), intent(out) :: sf_int 
    class(sf_data_t), intent(in), target :: data
  end subroutine circe1_init

end module sf_circe1