gcc/testsuite/gfortran.dg/host_assoc_variable_1.f90

   1 ! { dg-do compile }
   2 ! This tests that PR32760, in its various manifestations is fixed.
   3 !
   4 ! Contributed by Harald Anlauf <anlauf@gmx.de>
   5 !
   6 ! This is the original bug - the frontend tried to fix the flavor of
   7 ! 'PRINT' too early so that the compile failed on the subroutine
   8 ! declaration.
   9 !
  10 module gfcbug68
  11   implicit none
  12   public :: print
  13 contains
  14   subroutine foo (i)
  15     integer, intent(in)  :: i
  16     print *, i
  17   end subroutine foo
  18   subroutine print (m)
  19     integer, intent(in) :: m
  20   end subroutine print
  21 end module gfcbug68
  22
  23 ! This version of the bug appears in comment # 21.
  24 !
  25 module m
  26   public :: volatile
  27 contains
  28   subroutine foo
  29     volatile :: bar
  30   end subroutine foo
  31   subroutine volatile
  32   end subroutine volatile
  33 end module
  34
  35 ! This was a problem with the resolution of the STAT parameter in
  36 ! ALLOCATE and DEALLOCATE that was exposed in comment #25.
  37 !
  38 module n
  39   public :: integer
  40   private :: istat
  41 contains
  42   subroutine foo
  43     integer, allocatable :: s(:), t(:)
  44     allocate(t(5))
  45     allocate(s(4), stat=istat)
  46   end subroutine foo
  47   subroutine integer()
  48   end subroutine integer
  49 end module n
  50
  51 ! This is the version of the bug in comment #12 of the PR.
  52 !
  53 module gfcbug68a
  54   implicit none
  55   public :: write
  56 contains
  57   function foo (i)
  58     integer, intent(in)  :: i
  59     integer foo
  60     write (*,*) i
  61     foo = i
  62   end function foo
  63   subroutine write (m)
  64     integer, intent(in) :: m
  65     print *, m*m*m
  66   end subroutine write
  67 end module gfcbug68a
  68
  69 program testit
  70   use gfcbug68a
  71   integer :: i = 27
  72   integer :: k
  73   k = foo(i)
  74   print *, "in the main:", k
  75   call write(33)
  76 end program testit
  77 ! { dg-final { cleanup-modules "gfcbug68 gfcbug68a m n" } }