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

--- Comment #10 from Jakub Jelinek <jakub at gcc dot gnu.org> ---
Ah, the following shows what is happening and shows similar IL changes in the
*.optimized dump:
module m1
  type  amg_d_base_solver_type
  contains
    procedure, pass(sv) :: free => amg_d_base_solver_free
  end type amg_d_base_solver_type
  interface
    subroutine amg_d_base_solver_free(sv,x)
      import :: amg_d_base_solver_type
      implicit none
      class(amg_d_base_solver_type), intent(inout) :: sv
      integer,intent(inout)          :: x
    end subroutine amg_d_base_solver_free
  end interface
end module m1
module m2
  use m1
  type  amg_d_base_smoother_type
    class(amg_d_base_solver_type), allocatable :: sv
  contains
    procedure, pass(sm) :: free => amg_d_base_smoother_free
  end type amg_d_base_smoother_type
  interface
    subroutine amg_d_base_smoother_free(sm,x)
      import :: amg_d_base_smoother_type, amg_d_base_solver_type
      implicit none
      class(amg_d_base_smoother_type), intent(inout) :: sm
      integer,intent(inout)          :: x
    end subroutine amg_d_base_smoother_free
  end interface
end module m2
module m3
  use m2
  type amg_d_onelev_type
    class(amg_d_base_smoother_type), allocatable   :: sm
  end type amg_d_onelev_type
end module m3
subroutine foo (level, save1, info)
  use m1
  use m2
  use m3
  type(amg_d_onelev_type), intent(inout) :: level
  class(amg_d_base_smoother_type), allocatable , intent(inout) :: save1
  integer,intent(out) :: info
  info = 0
  if (allocated(save1)) then
    call save1%free(info)
    if (info  == 0) deallocate(save1,stat=info)
    if (info /= 0) return
  end if
  allocate(save1, mold=level%sm,stat=info)
end subroutine

Reply via email to