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!
10module gfcbug68
11  implicit none
12  public :: print
13contains
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
21end module gfcbug68
22
23! This version of the bug appears in comment # 21.
24!
25module m
26  public :: volatile
27contains
28  subroutine foo
29    volatile :: bar
30  end subroutine foo
31  subroutine volatile
32  end subroutine volatile
33end 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!
38module n
39  public :: integer
40  private :: istat
41contains
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
49end module n
50
51! This is the version of the bug in comment #12 of the PR.
52!
53module gfcbug68a
54  implicit none
55  public :: write
56contains
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
67end module gfcbug68a
68
69program 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)
76end program testit
77