1! { dg-do compile }
2! { dg-options "-O2" }
3! { dg-require-visibility "" }
4!
5! PR fortran/52751 (top, "module mod")
6! PR fortran/40973 (bottom, "module m")
7!
8! Ensure that (only) those module variables and procedures which are PRIVATE
9! and have no C-binding label are optimized away.
10!
11      module mod
12        integer :: aa
13        integer, private :: iii
14        integer, private, bind(C) :: jj             ! { dg-warning "PRIVATE but has been given the binding label" }
15        integer, private, bind(C,name='lll') :: kk  ! { dg-warning "PRIVATE but has been given the binding label" }
16        integer, private, bind(C,name='') :: mmmm
17        integer, bind(C) :: nnn
18        integer, bind(C,name='oo') :: pp
19        integer, bind(C,name='') :: qq
20      end module mod
21
22! The two xfails below have appeared with the introduction of submodules. 'iii' and
23! 'mmm' now are TREE_PUBLIC but has DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN set.
24
25      ! { dg-final { scan-assembler "__mod_MOD_aa" } }
26      ! { dg-final { scan-assembler-not "iii" { xfail *-*-* } } }
27      ! { dg-final { scan-assembler "jj" } }
28      ! { dg-final { scan-assembler "lll" } }
29      ! { dg-final { scan-assembler-not "kk" } }
30      ! { dg-final { scan-assembler-not "mmmm" { xfail *-*-* } } }
31      ! { dg-final { scan-assembler "nnn" } }
32      ! { dg-final { scan-assembler "oo" } }
33      ! { dg-final { scan-assembler "__mod_MOD_qq" } }
34
35MODULE M
36  PRIVATE :: two, three, four, six
37  PUBLIC :: one, seven, eight, ten
38CONTAINS
39  SUBROUTINE one(a)
40    integer :: a
41    a = two()
42  END SUBROUTINE one
43  integer FUNCTION two()
44     two = 42
45  END FUNCTION two
46  integer FUNCTION three() bind(C) ! { dg-warning "PRIVATE but has been given the binding label" }
47     three = 43
48  END FUNCTION three
49  integer FUNCTION four() bind(C, name='five') ! { dg-warning "PRIVATE but has been given the binding label" }
50     four = 44
51  END FUNCTION four
52  integer FUNCTION six() bind(C, name='')
53     six = 46
54  END FUNCTION six
55  integer FUNCTION seven() bind(C)
56     seven = 46
57  END FUNCTION seven
58  integer FUNCTION eight() bind(C, name='nine')
59     eight = 48
60  END FUNCTION eight
61  integer FUNCTION ten() bind(C, name='')
62     ten = 48
63  END FUNCTION ten
64END MODULE
65
66! { dg-final { scan-assembler "__m_MOD_one" } }
67! { dg-final { scan-assembler-not "two" } }
68! { dg-final { scan-assembler "three" } }
69! { dg-final { scan-assembler-not "four" } }
70! { dg-final { scan-assembler "five" } }
71! { dg-final { scan-assembler-not "six" } }
72! { dg-final { scan-assembler "seven" } }
73! { dg-final { scan-assembler "nine" } }
74! { dg-final { scan-assembler "__m_MOD_ten" } }
75