Fortran/gfortran/regression/finalize_51.f90

! { dg-do run }
!
! Test assumed rank finalizers
!
module finalizable_m
! F2018: 7.5.6.2 para 1: "Otherwise, if there is an elemental final
! subroutine whose dummy argument has the same kind type parameters
! as the entity being finalized, or a final subroutine whose dummy
! argument is assumed-rank with the same kind type parameters as the
! entity being finalized, it is called with the entity as an actual
! argument."
  implicit none

  type finalizable_t
    integer :: component_
  contains
    final :: finalize
  end Type

  interface finalizable_type
    module procedure construct0, construct1
  end interface

  integer :: final_ctr = 0

contains

  pure function construct0(component) result(finalizable)
    integer, intent(in) :: component
    type(finalizable_t) finalizable
    finalizable%component_ = component
  end function

  impure function construct1(component) result(finalizable)
    integer, intent(in), dimension(:) :: component
    type(finalizable_t), dimension(:), allocatable :: finalizable
    integer :: sz
    sz = size(component)
    allocate (finalizable (sz))
    finalizable%component_ = component
  end function

  subroutine finalize(self)
    type(finalizable_t), intent(inout), dimension (..) :: self
    select rank (self)
    rank (0)
        print *, "rank 0 value = ", self%component_
    rank (1)
        print *, "rank 1 value = ", self%component_
    rank default
        print *, "rank default"
    end select
    final_ctr = final_ctr + 1
  end subroutine

end module

program specification_expression_finalization
  use finalizable_m
  implicit none

  type(finalizable_t) :: a = finalizable_t (1)
  type(finalizable_t) :: b(2) = [finalizable_t (2), finalizable_t (3)]

  a = finalizable_type (42)
  if (final_ctr .ne. 2) stop 1
  b = finalizable_type ([42, 43])
  print *, b%component_

end program