1! { dg-do run }
2! Tests the fix for PR33897, in which gfortran missed that the
3! declaration of 'setbd' in 'nxtstg2' made it external.  Also
4! the ENTRY 'setbd' would conflict with the external 'setbd'.
5!
6! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
7!
8MODULE ksbin1_aux_mod
9 CONTAINS
10  SUBROUTINE nxtstg1()
11    INTEGER :: i
12    i = setbd()  ! available by host association.
13    if (setbd () .ne. 99 ) call abort ()
14  END SUBROUTINE nxtstg1
15
16  SUBROUTINE nxtstg2()
17    INTEGER :: i
18    integer :: setbd  ! makes it external.
19    i = setbd()       ! this is the PR
20    if (setbd () .ne. 42 ) call abort ()
21  END SUBROUTINE nxtstg2
22
23  FUNCTION binden()
24    INTEGER :: binden
25    INTEGER :: setbd
26    binden = 0
27  ENTRY setbd()
28    setbd = 99
29  END FUNCTION binden
30END MODULE ksbin1_aux_mod
31
32PROGRAM test
33  USE ksbin1_aux_mod, only : nxtstg1, nxtstg2
34  integer setbd ! setbd is external, since not use assoc.
35  CALL nxtstg1()
36  CALL nxtstg2()
37  if (setbd () .ne. 42 ) call abort ()
38  call foo
39contains
40  subroutine foo
41    USE ksbin1_aux_mod ! module setbd is available
42    if (setbd () .ne. 99 ) call abort ()
43  end subroutine
44END PROGRAM test
45
46INTEGER FUNCTION setbd()
47  setbd=42
48END FUNCTION setbd
49