[Bug fortran/87359] [9 regression] pointer being freed was not allocated

[juergen.reuter at desy dot de]

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

--- Comment #37 from Jürgen Reuter <juergen.reuter at desy dot de> ---
Paul, here is a simple reproducer of 89 lines, this should now make it
relatively
easy to debug, I am using gcc trunk revision r264501.
Here is the code (I will also attach it), it contains also a workaround for the
runtime error:
module phs_fks
  implicit none
  private
  public :: phs_identifier_t
  public :: phs_fks_t
  type :: phs_identifier_t
     integer, dimension(:), allocatable :: contributors
  contains
    procedure :: init => phs_identifier_init
  end type phs_identifier_t

  type :: phs_fks_t
     type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers
  end type phs_fks_t
contains

  subroutine phs_identifier_init &
     (phs_id, contributors)
     class(phs_identifier_t), intent(out) :: phs_id
     integer, intent(in), dimension(:) :: contributors
     allocate (phs_id%contributors (size (contributors)))
     phs_id%contributors = contributors
   end subroutine phs_identifier_init

end module phs_fks

!!!!!

module instances
  use phs_fks
  implicit none
  private
  public :: process_instance_t

  type :: nlo_event_deps_t
     type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers
  end type nlo_event_deps_t

  type :: process_instance_t
     type(phs_fks_t), pointer :: phs => null ()
     type(nlo_event_deps_t) :: event_deps     
   contains
     procedure :: init => process_instance_init
     procedure :: setup_real_event_kinematics => pi_setup_real_event_kinematics
  end type process_instance_t

contains

  subroutine process_instance_init (instance)
    class(process_instance_t), intent(out), target :: instance
    integer :: i
    integer :: i_born, i_real
    print *, "Process instance init"
    allocate (instance%phs)
  end subroutine process_instance_init

  subroutine pi_setup_real_event_kinematics (process_instance)
    class(process_instance_t), intent(inout) :: process_instance    
    integer :: i_real, i    
    associate (event_deps => process_instance%event_deps)
       i_real = 2 
       associate (phs => process_instance%phs)
          print *, "Type is phs_fks_t"
          allocate (phs%phs_identifiers (3))
          call phs%phs_identifiers(1)%init ([1])
          call phs%phs_identifiers(2)%init ([1,2])
          call phs%phs_identifiers(3)%init ([1,2,3])          
          event_deps%phs_identifiers = phs%phs_identifiers
          !!!! Workaround
          ! allocate (event_deps%phs_identifiers (size (phs%phs_identifiers)))
          ! do i = 1, size (phs%phs_identifiers)
          !    event_deps%phs_identifiers(i) = phs%phs_identifiers(i)
          ! end do          
       end associate
    end associate
  end subroutine pi_setup_real_event_kinematics

end module instances

!!!!!

program main
  use instances, only: process_instance_t
  implicit none  
  type(process_instance_t), allocatable, target :: process_instance
  allocate (process_instance)
  call process_instance%init ()
  call process_instance%setup_real_event_kinematics ()     
end program main