1! { dg-do compile }
2! { dg-options "-std=f2003" }
3! PR fortran/34133
4!
5! The compiler should reject internal procedures with BIND(c) attribute
6! for Fortran 2003.
7!
8subroutine foo() bind(c)
9contains
10  subroutine bar() bind (c) ! { dg-error "may not be specified for an internal" }
11  end subroutine bar ! { dg-error "Expected label" }
12end subroutine foo ! { dg-error "Fortran 2008: CONTAINS statement" }
13
14subroutine foo2() bind(c)
15  use iso_c_binding
16contains
17  integer(c_int) function barbar() bind (c) ! { dg-error "may not be specified for an internal" }
18  end function barbar ! { dg-error "Expecting END SUBROUTINE" }
19end subroutine foo2 ! { dg-error "Fortran 2008: CONTAINS statement" }
20
21function one() bind(c)
22  use iso_c_binding
23  integer(c_int) :: one
24  one = 1
25contains
26  integer(c_int) function two() bind (c) ! { dg-error "may not be specified for an internal" }
27  end function two ! { dg-error "Expected label" }
28end function one ! { dg-error "Fortran 2008: CONTAINS statement" }
29
30function one2() bind(c)
31  use iso_c_binding
32  integer(c_int) :: one2
33  one2 = 1
34contains
35  subroutine three() bind (c) ! { dg-error "may not be specified for an internal" }
36  end subroutine three ! { dg-error "Expecting END FUNCTION statement" }
37end function one2 ! { dg-error "Fortran 2008: CONTAINS statement" }
38
39program main
40  use iso_c_binding
41  implicit none
42contains
43  subroutine test() bind(c) ! { dg-error "may not be specified for an internal" }
44  end subroutine test ! { dg-error "Expecting END PROGRAM" }
45  integer(c_int) function test2() bind (c) ! { dg-error "may not be specified for an internal" }
46  end function test2  ! { dg-error "Expecting END PROGRAM" }
47end program main ! { dg-error "Fortran 2008: CONTAINS statement" }
48