! { dg-do run }
!
! Test the fix for pr91396 in which some of the expected finalizations
! did not occur; within s3 and s4 scopes.
!
! Contributed by Jose Rui Faustine de Sousa  <jrfsousa@gcc.gnu.org>
!
module final_m

  implicit none

  private

  public ::        &
    assignment(=)

  public :: &
    final_t

  integer, public :: final_count

  public ::     &
    final_init, &
    final_set,  &
    final_get,  &
    final_end

  type :: final_t
    private
    integer :: n = -1
  contains
    final :: final_end
  end type final_t

  interface assignment(=)
    module procedure final_init
  end interface assignment(=)

contains

  elemental subroutine final_init(this, n)
    type(final_t), intent(out) :: this
    integer,       intent(in)  :: n

    this%n = n
    return
  end subroutine final_init

  elemental function final_set(n) result(this)
    integer, intent(in) :: n

    type(final_t) :: this

    this%n = n
    return
  end function final_set

  elemental function final_get(this) result(n)
    type(final_t), intent(in) :: this

    integer :: n

    n = this%n
    return
  end function final_get

  subroutine final_end(this)
    type(final_t), intent(inout) :: this

    final_count = final_count + 1
    this%n = -1
    return
  end subroutine final_end

end module final_m

program final_p

  use final_m

  implicit none

  type(final_t) :: f0

!  print *, "enter main"
  call final_init(f0, 0)
!  print *, "enter final_s1"
  call final_s1()
!  print *, "exit final_s1"
!  print *, "enter final_s2"
  call final_s2()
!  print *, "exit final_s2"
!  print *, "enter final_s3"
  call final_s3()
!  print *, "exit final_s3"
!  print *, "enter final_s4"
  call final_s4()
!  print *, "exit final_s4"
!  print *, "f0: ", final_get(f0)
  ! this should be automatic...
  call final_end(f0)
  if (final_count /= 10) stop 1
  stop

contains

  subroutine final_s1()

    type(final_t) :: f

    call final_init(f, 1)
    print *, "f1: ", final_get(f)
! Two finalizations for INTENT(OUT) in final_init this scope and main program.
    if (final_count /= 2) stop 2
    return
  end subroutine final_s1

  subroutine final_s2()

    type(final_t) :: f

    f = 2
! One finalization for INTENT(OUT) in final_init, used in the defined assignment
! and one for leaving 's1' scope.
    if (final_count /= 4) stop 3
    print *, "f2: ", final_get(f)
    return
  end subroutine final_s2

  subroutine final_s3()

    type(final_t) :: f

    f = final_set(3)
    print *, "f3: ", final_get(f)
! One finalization for 'var, in the assignment, one for the result of final_set
! and one for leaving 's2' scope.
    if (final_count /= 7) stop 4
    return
  end subroutine final_s3

  subroutine final_s4()

    print *, "f4: ", final_get(final_set(4)), " ", final_count
! One finalization for the result of final_set and one for leaving 's3' scope.
    return
  end subroutine final_s4

end program final_p