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