gcc/testsuite/gfortran.dg/finalize_43.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR80524, where gfortran on issued one final call
   4 ! For 'u' going out of scope. Two further call should be emitted; one
   5 ! for the lhs of the assignment in 's' and the other for the function
   6 ! result, which occurs after assignment.
   7 !
   8 ! Contributed by Andrew Wood  <andrew@fluidgravity.co.uk>
   9 !
  10 MODULE m1
  11    IMPLICIT NONE
  12    integer :: counter = 0
  13    integer :: fval = 0
  14    TYPE t
  15       INTEGER :: i
  16       CONTAINS
  17          FINAL :: t_final
  18    END TYPE t
  19    CONTAINS
  20       SUBROUTINE t_final(this)
  21          TYPE(t) :: this
  22          counter = counter + 1
  23       END SUBROUTINE
  24       FUNCTION new_t()
  25          TYPE(t) :: new_t
  26          new_t%i = 1
  27          fval = new_t%i
  28          if (counter /= 0) stop 1   ! Finalization of 'var' after evaluation of 'expr'
  29       END FUNCTION new_t
  30       SUBROUTINE s
  31          TYPE(t) :: u
  32          u = new_t()
  33          if (counter /= 2) stop 2   ! Finalization of 'var' and 'expr'
  34       END SUBROUTINE s
  35 END MODULE m1
  36 PROGRAM prog
  37    USE m1
  38    IMPLICIT NONE
  39    CALL s
  40    if (counter /= 3) stop 3         ! Finalization of 'u' in 's'
  41 END PROGRAM prog