|
111
|
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 !
|
|
|
8 MODULE ksbin1_aux_mod
|
|
|
9 CONTAINS
|
|
|
10 SUBROUTINE nxtstg1()
|
|
|
11 INTEGER :: i
|
|
|
12 i = setbd() ! available by host association.
|
|
131
|
13 if (setbd () .ne. 99 ) STOP 1
|
|
111
|
14 END SUBROUTINE nxtstg1
|
|
|
15
|
|
|
16 SUBROUTINE nxtstg2()
|
|
|
17 INTEGER :: i
|
|
|
18 integer :: setbd ! makes it external.
|
|
|
19 i = setbd() ! this is the PR
|
|
131
|
20 if (setbd () .ne. 42 ) STOP 2
|
|
111
|
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
|
|
|
30 END MODULE ksbin1_aux_mod
|
|
|
31
|
|
|
32 PROGRAM 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()
|
|
131
|
37 if (setbd () .ne. 42 ) STOP 3
|
|
111
|
38 call foo
|
|
|
39 contains
|
|
|
40 subroutine foo
|
|
|
41 USE ksbin1_aux_mod ! module setbd is available
|
|
131
|
42 if (setbd () .ne. 99 ) STOP 4
|
|
111
|
43 end subroutine
|
|
|
44 END PROGRAM test
|
|
|
45
|
|
|
46 INTEGER FUNCTION setbd()
|
|
|
47 setbd=42
|
|
|
48 END FUNCTION setbd
|
