gcc/testsuite/gfortran.dg/pr84674.f90

! { dg-do run }
!
! Test the fix for PR84674, in which the non-overridable variant of the
! procedure ff below caused a runtime segfault.
!
! Contributed by Jakub Benda  <albandil@atlas.cz>
!
 module m
  implicit none

  type, abstract :: t1
   integer :: i
  contains
   procedure(i_f), pass(u), deferred :: ff
  end type t1

  type, abstract, extends(t1) :: t2
  contains
   procedure, non_overridable, pass(u) :: ff => f ! Segmentation fault
   !procedure, pass(u) :: ff => f ! worked
  end type t2

  type, extends(t2) :: DerivedType
  end type DerivedType

  abstract interface
   subroutine i_f(u)
    import :: t1
    class(t1), intent(inout) :: u
   end subroutine i_f
  end interface

 contains

  subroutine f(u)
   class(t2), intent(inout) :: u
    u%i = 3*u%i
  end subroutine f

 end module m


 program p

  use m

  implicit none

  class(t1), allocatable :: v

  allocate(DerivedType::v)
  v%i = 2
  call v%ff()
  if (v%i /= 6) stop
 end program p