gcc/testsuite/gfortran.dg/finalize_49.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! Test conformance with clause 7.5.6.3, paragraph 6 of F2018. Part of PR106576.
   5 !
   6 ! Contributed by Damian Rouson  <damian@archaeologic.codes>
   7 !
   8 module finalizable_m
   9   !! This module supports the main program at the bottom of this file, which
  10   !! tests compiler conformance with clause 7.5.6.3, paragraph 6 in the Fortran
  11   !! Interpretation Document (https://j3-fortran.org/doc/year/18/18-007r1.pdf):
  12   !! "If a specification expression in a scoping unit references
  13   !! a function, the result is finalized before execution of the executable
  14   !! constructs in the scoping unit."
  15   implicit none
  16
  17   private
  18   public :: finalizable_t, component
  19
  20   type finalizable_t
  21     private
  22     integer, allocatable :: component_
  23   contains
  24     final :: finalize
  25   end Type
  26
  27   interface finalizable_t
  28     module procedure construct
  29   end interface
  30
  31 contains
  32
  33   pure function construct(component) result(finalizable)
  34     integer, intent(in) :: component
  35     type(finalizable_t) finalizable
  36     allocate(finalizable%component_, source = component)
  37   end function
  38
  39   pure function component(self) result(self_component)
  40     type(finalizable_t), intent(in) :: self
  41     integer self_component
  42     self_component = self%component_
  43   end function
  44
  45   pure subroutine finalize(self)
  46     type(finalizable_t), intent(inout) :: self
  47     if (allocated(self%component_)) deallocate(self%component_)
  48   end subroutine
  49
  50 end module
  51
  52 program specification_expression_finalization
  53   use finalizable_m, only : finalizable_t, component
  54   implicit none
  55
  56   call finalize_specification_expression_result
  57
  58 contains
  59
  60   subroutine finalize_specification_expression_result
  61     real tmp(component(finalizable_t(component=1))) !! Finalizes the finalizable_t function result
  62     real eliminate_unused_variable_warning
  63     tmp = eliminate_unused_variable_warning
  64   end subroutine
  65
  66 end program
  67 ! { dg-final { scan-tree-dump-times "_final != 0B" 1 "original" } }