gcc/testsuite/gfortran.dg/host_assoc_variable_1.f90

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