1! { dg-do compile }
2! { dg-options "-std=gnu" }
3! PR fortran/34133
4!
5! bind(C,name="...") is invalid for dummy procedures
6! and for internal procedures.
7!
8subroutine dummy1(a,b)
9!  implicit none
10  interface
11    function b() bind(c,name="jakl") ! { dg-error "no binding name is allowed" }
12!     use iso_c_binding
13!     integer(c_int) :: b       
14    end function b ! { dg-error "Expecting END INTERFACE" }
15  end interface
16  interface
17    subroutine a() bind(c,name="") ! { dg-error "no binding name is allowed" }
18    end subroutine a ! { dg-error "Expecting END INTERFACE" }
19  end interface
20end subroutine dummy1
21
22subroutine internal()
23  implicit none
24contains
25  subroutine int1() bind(c, name="jj") ! { dg-error "No binding name is allowed" }
26  end subroutine int1 ! { dg-error "Expected label" }
27end subroutine internal
28
29subroutine internal1()
30  use iso_c_binding
31  implicit none
32contains
33  integer(c_int) function int2() bind(c, name="jjj") ! { dg-error "No binding name is allowed" }
34  end function int2 ! { dg-error "Expecting END SUBROUTINE" }
35end subroutine internal1
36
37integer(c_int) function internal2()
38  use iso_c_binding
39  implicit none
40  internal2 = 0
41contains
42  subroutine int1() bind(c, name="kk") ! { dg-error "No binding name is allowed" }
43  end subroutine int1 ! { dg-error "Expecting END FUNCTION" }
44end function internal2
45
46integer(c_int) function internal3()
47  use iso_c_binding
48  implicit none
49  internal3 = 0
50contains
51  integer(c_int) function int2() bind(c, name="kkk") ! { dg-error "No binding name is allowed" }
52  end function int2 ! { dg-error "Expected label" }
53end function internal3
54
55program internal_prog
56  use iso_c_binding
57  implicit none
58contains
59  subroutine int1() bind(c, name="mm") ! { dg-error "No binding name is allowed" }
60  end subroutine int1 ! { dg-error "Expecting END PROGRAM statement" }
61  integer(c_int) function int2() bind(c, name="mmm") ! { dg-error "No binding name is allowed" }
62  end function int2 ! { dg-error "Expecting END PROGRAM statement" } 
63end program
64