gcc/testsuite/gfortran.dg/associate_25.f90

   1 ! { dg-do run }
   2 !
   3 ! Checks the fix for PR60483.
   4 !
   5 ! Contributed by Anthony Lewis  <antony@cosmologist.info>
   6 !
   7 module A
   8   implicit none
   9   Type T
  10     integer :: val = 2
  11   contains
  12     final :: testfree
  13   end type
  14   integer :: final_flag = 0
  15 contains
  16   subroutine testfree(this)
  17     Type(T) this
  18     final_flag = this%val + final_flag
  19   end subroutine
  20   subroutine Testf()
  21     associate(X => T()) ! This was failing: Symbol 'x' at (1) has no IMPLICIT type
  22       final_flag = X%val
  23     end associate
  24 ! This should now be 4 but the finalization is not happening.
  25 ! TODO put it right!
  26     if (final_flag .ne. 2) call abort
  27   end subroutine Testf
  28 end module
  29
  30   use A
  31   call Testf
  32 end